home *** CD-ROM | disk | FTP | other *** search
/ EnigmA Amiga Run 1997 February / EnigmA AMIGA RUN 15 (1997)(G.R. Edizioni)(IT)[!][issue 1997-02][PLANET CD V].iso / enigma / earcd / editor / editor2 / fnlwrppr.lha / FinalWrapper3_12 / FinalWrapper.rexx < prev    next >
OS/2 REXX Batch file  |  1996-10-31  |  52KB  |  2,463 lines
  1. /* $VER: FinalWrapper 3.12 (31.10.96) by NDY's */
  2. version="3.12"
  3. date="31.10.96"
  4. OPTIONS RESULTS
  5. SIGNAL ON ERROR
  6. SIGNAL ON SYNTAX
  7. SIGNAL ON BREAK_C
  8. ARG cliarg
  9. initerr=init()
  10. rxport=ADDRESS()
  11. IF ~(Left(rxport,Length(finalw))=finalw) THEN
  12. DO
  13. DO i=1 TO 20 UNTIL portok
  14. rxport=finalw||i
  15. portok=Show("p",rxport)
  16. END
  17. IF portok THEN ADDRESS VALUE rxport
  18. END
  19. portok=Show("p",rxport)
  20. CALL locale
  21. CALL checkenv
  22. CALL loaddef(1)
  23. IF portok THEN
  24. DO
  25. GetDocItemPrefs "DECIMAL"
  26. deci=Upper(RESULT)
  27. DocItemPrefs "DECIMAL PERIOD" 
  28. CALL options
  29. CALL chosenobjs
  30. CALL oval
  31. CALL scan
  32. CALL resetprefs
  33. END
  34. meas=measure.1
  35. IF portok THEN
  36. DO
  37. GetDisplayPrefs "MEASURE"
  38. RESULT=Upper(RESULT)
  39. SELECT
  40. WHEN RESULT="INCHES" THEN meas=measure.2
  41. WHEN RESULT="METRIC" THEN meas=measure.3
  42. WHEN RESULT="PICA" THEN meas=measure.4
  43. OTHERWISE NOP
  44. END
  45. END
  46. DO id=agads+1 TO agads+sgads
  47. ltxt.id=replacepat(ltxt.id,"@m",meas)
  48. END
  49. IF guiinit()=5 THEN CALL message(50,nogui)
  50. init=0
  51. DO FOREVER
  52. CALL OnMenu(win,1024)
  53. IF ~zoomed THEN CALL ZipWindow(win)
  54. CALL ScreenToFront(scr)
  55. CALL ActivateWindow(win)
  56. CALL SetWindowTitles(win,wintitle,scrtitle)
  57. IF Left(text,Min(len.tgad,Length(text)))~=val.tgad THEN text=val.tgad
  58. DO UNTIL portok
  59. closed=0
  60. DO UNTIL closed~=0
  61. DO UNTIL closed~=0
  62. CALL WaitPkt(portname)
  63. CALL messy
  64. END
  65. DO id=1 TO agads+sgads
  66. IF labs.id>0 THEN CALL checkstrgad
  67. END
  68. IF closed=winclose | closed=okclose & prefsstore THEN CALL savedef(1)
  69. IF closed=cancelclose | closed=winclose THEN
  70. DO
  71. CALL bye(0)
  72. closed=0
  73. END
  74. IF closed=rxclose THEN
  75. DO
  76. ADDRESS COMMAND "Run >NIL: Rx "||defdir
  77. closed=0
  78. END
  79. IF closed=nextclose THEN
  80. DO
  81. ADDRESS VALUE rxport
  82. portok=1
  83. CALL newdoc
  84. closed=0
  85. END
  86. END
  87. closed=0
  88. portok=Show("P",rxport)
  89. IF ~portok THEN
  90. DO
  91. DO i=1 TO 20 UNTIL portok
  92. rxport=finalw||i
  93. portok=Show("p",rxport)
  94. END
  95. CALL newdoc
  96. END
  97. IF ~portok THEN
  98. CALL message(0,nofw)
  99. ELSE
  100. ADDRESS VALUE rxport
  101. END
  102. zoomed=BitTst(D2C(GETVALUE(win,24,4,"N")),28)
  103. IF ~zoomed THEN CALL ZipWindow(win) 
  104. CALL SetWindowTitles(win,aborttitle,busytitle)
  105. ScreenToFront
  106. CALL OffMenu(win,1024)
  107. GetDocItemPrefs "DECIMAL"
  108. deci=Upper(RESULT)
  109. DocItemPrefs "DECIMAL PERIOD" 
  110. CALL options
  111. IF chosenobjs()=0 THEN
  112. DO
  113. CALL oval
  114. CALL scan
  115. IF closed=0 THEN CALL text
  116. IF closed=0 THEN CALL wrap
  117. IF closed=0 THEN CALL group
  118. CALL updategadgets
  119. IF stilltoreply THEN
  120. DO
  121. CALL Reply(replymsg,0)
  122. stilltoreply=0
  123. END
  124. END
  125. CALL resetprefs
  126. END
  127. CALL bye(5)
  128. rembad: PROCEDURE 
  129. PARSE ARG t
  130. bad=XRange("00"x,"1F"x)||XRange("7F"x,"A0"x)
  131. i=Verify(t,bad,"m")
  132. l=Length(t)
  133. DO WHILE i>0
  134. t=Left(t,i-1) Right(t,l-i)
  135. i=Verify(t,bad,"m")
  136. END
  137. RETURN t
  138. replacepat: PROCEDURE 
  139. PARSE ARG str,pat,replc
  140. p=Pos(pat,str)
  141. DO WHILE p>0
  142. str=Left(str,p-1)||replc||SubStr(str,p+Length(pat))
  143. p=Pos(pat,str)
  144. END
  145. RETURN str
  146. gettexttypespecs: PROCEDURE 
  147. Status "FONTSIZE"
  148. p="SIZE" RESULT
  149. Status "FONTWIDTH"
  150. p=p "WIDTH" RESULT
  151. Status "FONTOBLIQUE"
  152. p=p "OBLIQUE" RESULT
  153. RETURN p
  154. radius: PROCEDURE 
  155. ARG a,rx,ry,v
  156. rx=rx*Cos(a)
  157. ry=ry*Sin(a)
  158. r=v*Sqrt(rx*rx+ry*ry)
  159. RETURN r
  160. getshort: PROCEDURE 
  161. ARG ptr,offset
  162. a=GETVALUE(D2C(ptr),offset,2,"N")
  163. IF a>32767 THEN a=a-65536
  164. RETURN a
  165. getpubname: 
  166. IF fwpub THEN
  167. pubname=fwpubscr
  168. ELSE
  169. DO
  170. pubname=""
  171. pubnptr=MAKEPOINTER(0,0,MAXPUBSCREENNAME,MEMF_CLEAR)
  172. IF pubnptr~=Null() THEN
  173. DO
  174. dummy=GetDefaultPubScreen(pubnptr)
  175. pubname=Import(pubnptr)
  176. CALL FREETHIS(pubnptr)
  177. END
  178. IF pubname="" THEN pubname="Workbench"
  179. IF pubname="Workbench" THEN CALL WBenchToFront()
  180. END
  181. RETURN pubname
  182. xexists: PROCEDURE 
  183. PARSE ARG file
  184. IF Pos(":",file)>0 THEN
  185. IF Pos(Upper(Left(file,Pos(":",file))),Upper(ShowList("A",,":")||ShowList("V",,":"))||":")>0 THEN
  186. ok=Exists(file)
  187. ELSE
  188. ok=0
  189. ELSE
  190. ok=Exists(file)
  191. RETURN ok
  192. newchkitem: 
  193. mchks=mchks+1
  194. chk=mchks+agads+tgads+wgads+sgads
  195. PARSE ARG ltxt.chk,mkey.chk,defchk.chk,mnode.chk
  196. RETURN chk
  197. newitem: 
  198. macts=macts+1
  199. nr=macts+mchks+agads+tgads+wgads+sgads
  200. PARSE ARG ltxt.nr,mkey.nr,mnode.nr
  201. RETURN nr
  202. newgadget: 
  203. agads=agads+1
  204. PARSE ARG labs.agads,lkey.agads,defchk.agads,defval.agads,defcyc.agads,gnode.agads,lbound.agads,ubound.agads
  205. RETURN agads
  206. newstr: 
  207. sgads=sgads+1
  208. gad=sgads+agads
  209. PARSE ARG len.gad,lkey.gad,line.gad,val.gad,gtype.gad,gnode.gad
  210. check.gad=0
  211. cycle.gad=0
  212. labs.gad=1
  213. slines=Max(slines,line.gad)
  214. RETURN gad
  215. newbutton: 
  216. tgads=tgads+1
  217. gad=tgads+agads+sgads
  218. PARSE ARG ltxt.gad,lkey.gad,lkey2.gad,gnode.gad
  219. RETURN gad
  220. newkey: 
  221. wgads=wgads+1
  222. gad=agads+tgads+wgads+sgads
  223. PARSE ARG lkey.gad,gnode.gad
  224. RETURN gad
  225. checksyntax: 
  226. PARSE ARG par.1,par.2,par.3
  227. ok=1
  228. DO i=1 TO 3 WHILE par.i~=""
  229. IF par.i=Upper(par.i) THEN INTERPRET "ar.i="||ar.i 
  230. ok=ok & Datatype(ar.i,par.i)
  231. END
  232. RETURN ok
  233. message: 
  234. PARSE ARG xiterr,msgtxt,buttxt,titletxt
  235. IF msgtxt="" THEN RETURN 0
  236. IF buttxt="" THEN buttxt=stdbut
  237. IF titletxt="" THEN titletxt=wintitle
  238. IF lib.reqtools THEN
  239. DO
  240. resume="BACKMSG"
  241. errtrap=14
  242. button=RTEZRequest(replacepat(msgtxt,"|","0A"x),buttxt,titletxt)
  243. END
  244. BACKMSG:
  245. IF trapped THEN 
  246. DO
  247. trapped=0
  248. lib.reqtools=0
  249. END
  250. IF ~lib.reqtools THEN
  251. IF lib.apig & cleangui & win~="00000000"x THEN
  252. button=EasyRequest(win,titletxt,replacepat(msgtxt,"|","0A"x),buttxt,Null(),0,0)
  253. ELSE
  254. SAY replacepat(msgtxt,"|","0A"x)
  255. IF xiterr>0 THEN CALL bye(xiterr)
  256. RETURN button
  257. init: 
  258. init=1
  259. bugreport="ENVARC:FinalWrapper/FWbugreport.rexx"
  260. errtext="@t (#@n)|in line @l"
  261. stdbut="OK"
  262. wintitle=""
  263. lockcnt=0
  264. errtrap=0
  265. getscrn=0
  266. catalog=0
  267. objs=0
  268. sobjs=0
  269. deci=""
  270. et=""
  271. cleangui=0
  272. stilltoreply=0
  273. replymsg="00000000"x
  274. apig=1
  275. lib.apig=0
  276. reqtools=4
  277. lib.reqtools=0
  278. win="00000000"x
  279. defprfs=""
  280. defspecs=""
  281. defcolour=""
  282. deffont=""
  283. portname="FinalWrapperPort"
  284. IF Show("P",portname) THEN
  285. DO
  286. ADDRESS VALUE portname
  287. IF cliarg~="" THEN
  288. INTERPRET cliarg
  289. ELSE
  290. PopFront
  291. CALL bye(0)
  292. END
  293. fwkey="ENVARC:FinalWrapper/FWKeyfile"
  294. libs=5
  295. DO i=1 TO libs
  296. lib.i=0
  297. END
  298. library.apig="apig.library"
  299. library.2="rexxmathlib.library"
  300. library.3="rexxsupport.library"
  301. library.reqtools="rexxreqtools.library"
  302. guidelib=5
  303. library.guidelib="amigaguide.library"
  304. DO libn=1 TO libs
  305. lib.libn=Show("l",library.libn)
  306. IF ~lib.libn THEN lib.libn=AddLib(library.libn,0,-30,0)
  307. IF ~lib.libn & libn~=guidelib & libn~=reqtools THEN RETURN 14
  308. END
  309. help=lib.guidelib
  310. defdir=""
  311. temp=""
  312. preff.1=""
  313. preff.2=""
  314. wb3=1
  315. IF xexists("ENV:Workbench") THEN
  316. IF Open(prefs,"ENV:Workbench","R") THEN
  317. DO
  318. wb3=(ReadLn(prefs)>=39)
  319. CALL Close(prefs)
  320. END
  321. IF xexists("ENV:FinalWrapper") THEN
  322. DO
  323. preff.1="ENV:FinalWrapper/FinalWrapper.def"
  324. temp="ENV:FinalWrapper/FinalWrapper.temp"
  325. foreigntexts="ENV:FinalWrapper/FinalWrapper."
  326. IF Open(prefs,"ENV:FinalWrapper/FWPath","R") THEN
  327. DO
  328. defdir=ReadLn(prefs)
  329. CALL Close(prefs)
  330. END
  331. END
  332. IF xexists("ENVARC:FinalWrapper") THEN
  333. DO
  334. preff.2="ENVARC:FinalWrapper/FinalWrapper.def"
  335. foreigntexts="ENVARC:FinalWrapper/FinalWrapper."
  336. END
  337. finalw="FINALW."
  338. fwpubscr="FinalWriterPubScreen"
  339. libn=libs
  340. port=0
  341. oldlen=0
  342. oldtxt=0
  343. oldoval=0
  344. oldobjs=0
  345. oldpara=-1
  346. oldppos=-1
  347. oldplen=-1
  348. txt=0
  349. oval=0
  350. rx=0
  351. ry=0
  352. ovalx=""
  353. ovaly=""
  354. ovalw=""
  355. ovalh=""
  356. ovalp=""
  357. text=""
  358. mchks=0
  359. macts=0
  360. agads=0
  361. sgads=0
  362. tgads=0
  363. wgads=0
  364. slines=0
  365. ovalscanned=0
  366. gadgettext=0
  367. virtualtext=1
  368. alen=0
  369. txtrot=0
  370. windowpos=0
  371. prefsstore=1
  372. trapped=0
  373. specs.0=""
  374. font.0=""
  375. colour.0=""
  376. dirtysize=1
  377. newtbprefs=1
  378. sheetused=0
  379. dirtytext=1
  380. obl="00011111122222233333444445555666677778888999AA"
  381. obrot="0006121722273135394245"
  382. ftabsize=0
  383. RETURN 0
  384. locale: 
  385. return=13 ; esc=27 ; bs=8 ; del=127
  386. IF xexists("ENV:") THEN
  387. ok=Open(prefs,"ENV:Language","R")
  388. ELSE
  389. ok=0
  390. IF ok THEN
  391. DO
  392. language=ReadLn(prefs)
  393. CALL Close(prefs)
  394. END
  395. ELSE
  396. language="english"
  397. ok=1
  398. IF xexists(foreigntexts||language) THEN
  399. IF Open(prefs,foreigntexts||language,"R") THEN
  400. DO
  401. DO UNTIL Eof(prefs)
  402. INTERPRET ReadLn(prefs)
  403. END
  404. CALL Close(prefs)
  405. ok=0
  406. END
  407. IF ok THEN 
  408. DO
  409. measure.1="?"
  410. measure.2="Inch"
  411. measure.3="cm"
  412. measure.4="Pica"
  413. docname="FinalWrapperSmall.Guide"
  414. origwintitle="@i - @f"
  415. origscrtitle="@i - @f"
  416. unnamed="Unnamed"
  417. defwinx=0
  418. defwiny=0
  419. aborttitle="<- Abort"
  420. busytitle="@i - Busy working, please wait..."
  421. gnode.0="REQUESTER"
  422. mnode.0="MENU"
  423. stdbut="OK"
  424. errtext="FinalWrapper failed:|@t|in line @l:|<@s>|(errornumber @n)"
  425. noselect="FinalWrapper failed:|First select an object and|a text block or some text|or enter the values in the|appropriate gadgets!"
  426. nolib="FinalWrapper failed:|Couldn't open '@y'"
  427. nofw="Run Final Writer first!"
  428. wrongos="FinalWrapper failed:|At least OS2.0 is required!"
  429. nogui="FinalWrapper failed:|Couldn't open requester!"
  430. notnum="@g|Value must be numeric!"
  431. noreqtools="Couldn't open rexxreqtools.library!"
  432. nohelp="On-line help not available!"
  433. rxcmderr="Unknown Arexx command|or syntax error:|@c"
  434. rxfilerq="Execute Arexx macro:"
  435. rxfileok="OK"
  436. about="FinalWrapper @v (@d)||For suggestions & bugs write to:|    Andreas Weiss|    Dorfstrasse 24|    CH-8212 Nohl|    (Switzerland)||(E-mail: ndys@ezinfo.vmsmail.ethz.ch)||This program is SHAREWARE!|The share is sfr/DM 20 or $15"
  437. arc=newgadget(2,"u",0,360,0,"ARC",0,9999)
  438. ltxt.arc.1="Use arc °: Clockwise"
  439. ltxt.arc.2="Use arc °: Anticlockwise"
  440. beg=newgadget(3,"b",0,0,0,"BEGIN",0,359)
  441. ltxt.beg.1="Begin °: Absolute"
  442. ltxt.beg.2="Begin °: Clockwise"
  443. ltxt.beg.3="Begin °: Anticlockwise"
  444. rot=newgadget(4,"r",0,0,0,"ROTATE",0,359)
  445. ltxt.rot.1="Rotate °: Absolute"
  446. ltxt.rot.2="Rotate °: Clockwise"
  447. ltxt.rot.3="Rotate °: Anticlockwise"
  448. ltxt.rot.4="Rotate  : Title mode"
  449. wrd=newgadget(-4,"j",0,0,0,"WORDMODE")
  450. ltxt.wrd.1="Join words: No"
  451. ltxt.wrd.2="Join words: Centered"
  452. ltxt.wrd.3="Join words: Align left"
  453. ltxt.wrd.4="Join words: Align right"
  454. adj=newgadget(-5,"a",0,0,0,"ADJUST")
  455. ltxt.adj.1="Adjust: Nothing"
  456. ltxt.adj.2="Adjust: Character size"
  457. ltxt.adj.3="Adjust: Character width"
  458. ltxt.adj.4="Adjust: Apparent width"
  459. ltxt.adj.5="Adjust: Arc"
  460. adjarc=5
  461. spl=newgadget(2,"s",0,25,0,"SPIRAL",1,100)
  462. ltxt.spl.1="Spiral %: Outside > inside"
  463. ltxt.spl.2="Spiral %: Inside > outside"
  464. siz=newgadget(2,"f",0,100,0,"SIZE",1,100)
  465. ltxt.siz.1="Font size %: Decreasing"
  466. ltxt.siz.2="Font size %: Increasing"
  467. zoo=newgadget(3,"z",0,50,0,"ZOOM",1,1000)
  468. ltxt.zoo.1="Zoom %: All"
  469. ltxt.zoo.2="Zoom %: Height"
  470. ltxt.zoo.3="Zoom %: Width"
  471. ink=newgadget(-5,"c",0,0,0,"COLOUR")
  472. ltxt.ink.1="Colour: From text"
  473. ltxt.ink.2="Colour: From oval fill"
  474. ltxt.ink.3="Colour: From oval border"
  475. ltxt.ink.4="Colour: Shadow = oval fill"
  476. ltxt.ink.5="Colour: Shadow = oval border"
  477. pat=newgadget(0,"p",0,0,0,"PATTERN")
  478. ltxt.pat="Pattern from selected text"
  479. xgad=newstr(7,"x",1,"",1,"XPOS")
  480. ltxt.xgad="(@m) X:"
  481. ygad=newstr(7,"y",1,"",1,"YPOS")
  482. ltxt.ygad="Y:"
  483. wgad=newstr(7,"w",1,"",1,"WIDTH")
  484. ltxt.wgad="Width:"
  485. hgad=newstr(7,"h",1,"",1,"HEIGHT")
  486. ltxt.hgad="Height:"
  487. pgad=newstr(4,"#",1,1,0,"PAGE")
  488. ltxt.pgad="# of page:"
  489. tgad=newstr(200,"t",2,"",2,"TEXT")
  490. ltxt.tgad="Text:"
  491. okgad=newbutton("  OK  ","o",RETURN,"OK")
  492. cancelgad=newbutton("Quit","q",esc,"CANCEL")
  493. closegad=newkey(del,"CLOSE")
  494. zipgad=newkey(" ","ZIP")
  495. depthgad=newkey(bs,"BACK")
  496. mtitle="Settings"
  497. mgad=newchkitem("Gadgets are auto-activated","G",1,"ACTIVATE")
  498. mspl=newchkitem("Adjust arc for spirals","A",1,"IMPROVE")
  499. mrel=newchkitem("Final Writer Release 3","F",0,"RELEASE")
  500. CALL newitem("","",mnode.0)
  501. mload=newitem("Load","L","LOAD")
  502. msave=newitem("Save","S","SAVE")
  503. mres=newitem("Reset","R","RESET")
  504. mdef=newitem("Defaults","D","DEFAULTS")
  505. CALL newitem("","",mnode.0)
  506. mtext=newitem("Text block preferences","T","TEXTPREFS")
  507. moval=newitem("Oval preferences","O","OVALPREFS")
  508. CALL newitem("","",mnode.0)
  509. mnext=newitem("Next Document","N","NEXT")
  510. mrexx=newitem("Execute Arexx macro...","E","MACRO")
  511. mhelp=newitem("Help...","H","HELP")
  512. mabt=newitem("About...","?","ABOUT")
  513. fwerrtext.5="Instruction didn't succeed"
  514. fwerrtext.10="Instruction failed"
  515. fwerrtext.20="Invalid arguments"
  516. fwerrtext.100="Unknown instruction"
  517. fwerrtext.200="Couldn't open fwarexx.library"
  518. END
  519. RETURN
  520. checkenv: 
  521. about=replacepat(replacepat(about,"@v",version),"@d",date)
  522. info=replacepat(replacepat("FinalWrapper @v by NDY's","@v",version),"@d",date)
  523. origwintitle=replacepat(origwintitle,"@i",info)
  524. origscrtitle=replacepat(origscrtitle,"@i",info)
  525. wtitle=origwintitle
  526. stitle=origscrtitle
  527. busytitle=replacepat(busytitle,"@i",info)
  528. doc=""
  529. CALL newdoc
  530. menus=mchks+macts
  531. gads=agads+tgads+sgads
  532. kgads=gads+wgads
  533. menuoff=kgads
  534. i=32+menuoff
  535. mnode.i=mnode.0
  536. prefsize=agads*4+mchks+4
  537. prefsid="FW30"||D2C(prefsize,2)
  538. tempsize=0
  539. IF temp~="" THEN
  540. DO id=agads+1 TO agads+sgads
  541. tempsize=tempsize+len.id
  542. END
  543. cancelclose=cancelgad-agads
  544. okclose=okgad-agads
  545. winclose=tgads+1
  546. rxclose=winclose+1
  547. nextclose=rxclose+1
  548. DO id=1 TO kgads
  549. IF ~Datatype(lkey.id,"W") THEN lkey.id=C2D(Upper(lkey.id))
  550. END
  551. IF initerr=14 THEN
  552. DO
  553. ln=replacepat(nolib,"@y",library.libn)
  554. CALL message(14,ln)
  555. CALL bye(14)
  556. END
  557. execbase=GETVALUE("4"x,0,4,"P")
  558. osversion=GETVALUE(execbase,20,2,"N")
  559. IF osversion<37 THEN CALL message(10,wrongos)
  560. IF ~xexists(fwkey) THEN fwkey=""
  561. IF help THEN
  562. DO
  563. docfile="HELP:"||language||"/"||docname
  564. IF ~xexists(docfile) THEN
  565. DO
  566. docfile="ENVARC:FinalWrapper/"||docname
  567. IF ~xexists(docfile) THEN help=0
  568. END
  569. END
  570. RETURN
  571. guiinit: 
  572. IF cleangui THEN RETURN 0
  573. pubscr=Null() ; scr=Null() ; win=Null() ; gad=Null() ; scrvinfo=Null() ; menu=Null() ; port=0 ; menustrip=0
  574. cleangui=1
  575. CALL SET_APIG_GLOBALS()
  576. GT_TAGBASE=X2D("80080000")
  577. GTMN_NEWLOOKMENUS=X2C("80080043")
  578. GTCB_SCALED=X2C("80080044")
  579. WA_NEWLOOKMENUS=X2C("80000093")
  580. nullbyte=D2C(0)
  581. port=OpenPort(portname)
  582. IF ~port THEN RETURN 5
  583. pubscr=LockPubScreen(fwpubscr)
  584. fwpub=(pubscr~=Null())
  585. IF ~fwpub & portok & fwkey~="" THEN
  586. DO
  587. SIGNAL OFF ERROR
  588. ADDRESS COMMAND ''fwkey''
  589. SIGNAL ON ERROR
  590. customscr=D2C(RC,4)
  591. END
  592. ELSE
  593. customscr=Null()
  594. IF fwpub THEN
  595. scr=pubscr
  596. ELSE
  597. IF customscr=Null() THEN
  598. DO
  599. pubscr=LockPubScreen("")
  600. IF pubscr=Null() THEN RETURN 5
  601. scr=pubscr
  602. END
  603. ELSE
  604. scr=customscr
  605. scrvinfo=GetVisualInfo(scr)
  606. IF scrvinfo=Null() THEN RETURN 5
  607. scrfont=GETVALUE(scr,40,4,"P")
  608. fonth=GETVALUE(scrfont,4,2,"N")
  609. scrrp=D2C(C2D(scr)+84)
  610. glistptr=MAKEPOINTER(0,0,4,MEMF_CLEAR)
  611. IF glistptr=Null() THEN RETURN 5
  612. borderl=GETVALUE(scr,36,1,"N")
  613. borderr=GETVALUE(scr,37,1,"N")
  614. bordert=GETVALUE(scr,35,1,"N")+fonth+1
  615. rows=2
  616. gadh=fonth+4
  617. gaddy=gadh+2
  618. DO i=1 TO 3+slines
  619. maxwidth.i=0
  620. END
  621. charw=TextLength(scrrp,"W"||nullbyte,-1) 
  622. intw=charw*4+12   
  623. strminw=charw*2+6
  624. addwidth=30+intw
  625. gperrow=agads%rows+agads//rows
  626. DO id=1 TO agads
  627. k=1+(id>gperrow)
  628. IF labs.id=0 THEN
  629. DO
  630. gwid.id=TextLength(scrrp,ltxt.id||nullbyte,-1)+34
  631. maxwidth.k=Max(maxwidth.k,gwid.id)
  632. END
  633. ELSE
  634. DO
  635. glabels.id=MAKEPOINTER(0,0,4*Abs(labs.id)+4,MEMF_CLEAR)
  636. IF glabels.id=Null() THEN RETURN 5
  637. DO i=1 TO Abs(labs.id) 
  638. lbuf.id.i=MAKEPOINTER(glabels.id,0,Length(ltxt.id.i)+1,MEMF_CLEAR)
  639. IF lbuf.id.i=Null() THEN RETURN 5
  640. CALL Export(lbuf.id.i,ltxt.id.i)
  641. CALL SETVALUE(glabels.id,(i-1)*4,4,"P",lbuf.id.i)
  642. xwid=TextLength(scrrp,ltxt.id.i||nullbyte,-1)+30
  643. IF labs.id>0 THEN xwid=xwid+addwidth
  644. maxwidth.k=Max(maxwidth.k,xwid)
  645. END
  646. END
  647. END
  648. DO i=1 TO slines
  649. nsgads.i=0
  650. END
  651. DO id=agads+1 TO agads+sgads
  652. gwid.id=TextLength(scrrp,ltxt.id||nullbyte,-1)
  653. lin=line.id
  654. maxnr=3+lin
  655. maxwidth.maxnr=maxwidth.maxnr+gwid.id+strminw+12
  656. nsgads.lin=nsgads.lin+1
  657. END
  658. DO id=agads+sgads+1 TO gads
  659. gwid.id=TextLength(scrrp,ltxt.id||nullbyte,-1)+6
  660. maxwidth.3=maxwidth.3+gwid.id+2
  661. END
  662. maxwidth=Max((Max(maxwidth.1,maxwidth.2)+4)*rows-4,maxwidth.3)
  663. DO i=4 TO slines+3
  664. maxwidth=Max(maxwidth,maxwidth.i)
  665. END
  666. winwid=maxwidth+4
  667. winhi=(gperrow+1+slines)*gaddy+6
  668. gadx=borderl+2
  669. gady=bordert+1
  670. gadw=maxwidth%rows-rows*2+2
  671. gadmaxx=winwid+borderl-2
  672. gadmaxy=winhi+bordert-1
  673. id=0
  674. gx=gadx
  675. cyx=gx
  676. chkx=gx+gadw-26
  677. intx=gx+gadw-28-intw
  678. textplace=PLACETEXT_LEFT
  679. DO i=0 TO 1
  680. DO j=0 TO gperrow-1 WHILE id<agads
  681. id=i*gperrow+j+1
  682. gadid=id*3
  683. IF labs.id>0 THEN
  684. DO
  685. newgadx.id=MAKENEWGADGET(scrvinfo,scrfont,gx,gady+j*gaddy,gadw-addwidth,gadh,"",0,gadid,Null())
  686. newgadxb.id=MAKENEWGADGET(scrvinfo,scrfont,chkx,gady+j*gaddy,26,gadh,"",0,gadid+1,Null())
  687. newgadxi.id=MAKENEWGADGET(scrvinfo,scrfont,intx,gady+j*gaddy,intw,gadh,"",0,gadid+2,Null())
  688. IF newgadxb.id=Null() | newgadxi.id=Null() | newgadx.id=Null() THEN RETURN 5
  689. END
  690. ELSE
  691. DO
  692. IF labs.id<0 THEN
  693. newgadx.id=MAKENEWGADGET(scrvinfo,scrfont,cyx,gady+j*gaddy,gadw,gadh,"",0,id*3,Null())
  694. ELSE
  695. newgadx.id=MAKENEWGADGET(scrvinfo,scrfont,chkx,gady+j*gaddy,26,gadh,ltxt.id,textplace,id*3+1,Null())
  696. IF newgadx.id=Null() THEN RETURN 5
  697. END
  698. END
  699. chkx=gadmaxx-gadw
  700. intx=chkx+28
  701. gx=chkx+addwidth
  702. cyx=chkx
  703. textplace=PLACETEXT_RIGHT
  704. END
  705. gy=gady+gaddy*gperrow
  706. DO i=1 TO slines
  707. gx=gadx
  708. maxnr=i+3
  709. strw=(maxwidth-maxwidth.maxnr)%(nsgads.i)+strminw
  710. DO id=agads+1 TO agads+sgads
  711. IF line.id=i THEN
  712. DO
  713. nsgads.i=nsgads.i-1
  714. IF nsgads.i=0 THEN strw=gadmaxx-(gx+gwid.id+8)
  715. newgadx.id=MAKENEWGADGET(scrvinfo,scrfont,gx+gwid.id+8,gy,strw,gadh,ltxt.id,PLACETEXT_LEFT,id*3+2,Null())
  716. gx=gx+gwid.id+strw+12
  717. IF newgadx.id=Null() THEN RETURN 5
  718. END
  719. END
  720. gy=gy+gaddy
  721. END
  722. gx=gadx+(maxwidth-maxwidth.3)%2
  723. DO id=agads+sgads+1 TO gads
  724. newgadx.id=MAKENEWGADGET(scrvinfo,scrfont,gx,gadmaxy-gadh,gwid.id,gadh,ltxt.id,PLACETEXT_IN,id*3,Null())
  725. gx=gx+gwid.id+4
  726. IF newgadx.id=Null() THEN RETURN 5
  727. END
  728. newgadbv=MAKENEWGADGET(scrvinfo,scrfont,gadx,gadmaxy-gadh-5,maxwidth,2,0,0,Null())
  729. gad=CreateContext(glistptr)
  730. prev=gad
  731. DO id=1 TO gads
  732. IF id>agads THEN
  733. IF id>agads+sgads THEN
  734. DO
  735. checkgad.id=CreateGadget(BUTTON_KIND,prev,newgadx.id,TAG_DONE,0)
  736. prev=checkgad.id
  737. END
  738. ELSE
  739. DO
  740. IF gtype.id=0 THEN
  741. intgad.id=CreateGadget(INTEGER_KIND,prev,newgadx.id,GTIN_NUMBER,val.id,GTIN_MAXCHARS,len.id,STRINGA_EXITHELP,1,TAG_DONE,0)
  742. ELSE
  743. intgad.id=CreateGadget(STRING_KIND,prev,newgadx.id,GTST_STRING,val.id,GTST_MAXCHARS,len.id,STRINGA_EXITHELP,1,TAG_DONE,0)
  744. prev=intgad.id
  745. END
  746. ELSE
  747. IF labs.id=0 THEN
  748. DO
  749. checkgad.id=CreateGadget(CHECKBOX_KIND,prev,newgadx.id,GTCB_CHECKED,check.id,GTCB_SCALED,-1,TAG_DONE,0)
  750. prev=checkgad.id
  751. END
  752. ELSE
  753. IF labs.id>0 THEN
  754. DO
  755. checkgad.id=CreateGadget(CHECKBOX_KIND,prev,newgadxb.id,GTCB_CHECKED,check.id,GTCB_SCALED,-1,TAG_DONE,0)
  756. intgad.id=CreateGadget(INTEGER_KIND,checkgad.id,newgadxi.id,GTIN_NUMBER,val.id,GTIN_MAXCHARS,4,STRINGA_EXITHELP,1,TAG_DONE,0)
  757. cyclegad.id=CreateGadget(CYCLE_KIND,intgad.id,newgadx.id,GTCY_LABELS,glabels.id,GTCY_ACTIVE,cycle.id,TAG_DONE,0)
  758. prev=cyclegad.id
  759. END
  760. ELSE
  761. DO
  762. cyclegad.id=CreateGadget(CYCLE_KIND,prev,newgadx.id,GTCY_LABELS,glabels.id,GTCY_ACTIVE,cycle.id,TAG_DONE,0)
  763. prev=cyclegad.id
  764. END
  765. END
  766. prev=CreateGadget(TEXT_KIND,prev,newgadbv,GTTX_BORDER,-1,TAG_DONE,0)
  767. IF prev=Null() THEN RETURN 5 
  768. mptr=MAKENEWMENU(menus)
  769. IF mptr=Null() THEN RETURN 5
  770. CALL ADDTO_NEWMENU(mptr,NM_TITLE,mtitle,"",0,0,Null())
  771. DO i=1 TO menus
  772. n=menuoff+i
  773. IF ltxt.n="" THEN
  774. mtxt=NM_BARLABEL
  775. ELSE
  776. mtxt=ltxt.n
  777. IF i>mchks THEN
  778. flags=MENUTOGGLE
  779. ELSE
  780. flags=CHECKED*check.n+CHECKIT+MENUTOGGLE
  781. IF Length(mkey.n)~=1 THEN mkey.n=""
  782. CALL ADDTO_NEWMENU(mptr,NM_ITEM,mtxt,mkey.n,flags,0,Null())
  783. END
  784. DROP ltxt
  785. CALL ADDTO_NEWMENU(mptr,NM_END,"","",0,0,Null())
  786. menu=CreateMenus(mptr,TAG_DONE,0)
  787. IF menu=Null() THEN RETURN 5
  788. IF LayoutMenus(menu,scrvinfo,GTMN_NEWLOOKMENUS,-1,TAG_DONE,0)=0 THEN RETURN 5
  789. winidcmp=IDCMP_CHANGEWINDOW+IDCMP_CLOSEWINDOW+IDCMP_GADGETUP+IDCMP_ACTIVEWINDOW+IDCMP_MOUSEBUTTONS+IDCMP_MENUPICK+IDCMP_VANILLAKEY+IDCMP_RAWKEY+IDCMP_MENUHELP
  790. winflags=WFLG_CLOSEGADGET+WFLG_DEPTHGADGET+WFLG_DRAGBAR+WFLG_ACTIVATE
  791. wtagl=MAKEPOINTER(0,0,104+8,MEMF_CLEAR)
  792. IF wtagl=Null() THEN RETURN 5
  793. wname=MAKEPOINTER(wtagl,0,Length(wintitle)+1,MEMF_CLEAR)
  794. IF wname=Null() THEN RETURN 5
  795. CALL Export(wname,wintitle)
  796. sname=MAKEPOINTER(wtagl,0,Length(scrtitle)+1,MEMF_CLEAR)
  797. IF sname=Null() THEN RETURN 5
  798. CALL Export(sname,scrtitle)
  799. wzipdims=MAKEPOINTER(wtagl,0,8,MEMF_CLEAR)
  800. IF wzipdims=Null() THEN RETURN 5
  801. zipwid=winwid+borderl+borderr
  802. ziphi=bordert
  803. CALL SETVALUE(wzipdims,4,2,"N",zipwid)
  804. CALL SETVALUE(wzipdims,6,2,"N",ziphi)
  805. CALL SETTAGSLOT(wtagl,0,WA_LEFT,"N",winx)
  806. CALL SETTAGSLOT(wtagl,1,WA_TOP,"N",winy)
  807. CALL SETTAGSLOT(wtagl,2,WA_INNERWIDTH,"N",winwid)
  808. CALL SETTAGSLOT(wtagl,3,WA_INNERHEIGHT,"N",winhi)
  809. CALL SETTAGSLOT(wtagl,4,WA_IDCMP,"N",winidcmp)
  810. CALL SETTAGSLOT(wtagl,5,WA_FLAGS,"N",winflags)
  811. CALL SETTAGSLOT(wtagl,6,WA_TITLE,"P",wname)
  812. CALL SETTAGSLOT(wtagl,7,WA_SCREENTITLE,"P",sname)
  813. CALL SETTAGSLOT(wtagl,8,WA_GADGETS,"P",gad)
  814. IF scr=pubscr THEN
  815. CALL SETTAGSLOT(wtagl,9,WA_PUBSCREEN,"P",scr)
  816. ELSE
  817. CALL SETTAGSLOT(wtagl,9,WA_CUSTOMSCREEN,"P",scr)
  818. CALL SETTAGSLOT(wtagl,10,WA_ZOOM,"P",wzipdims)
  819. CALL SETTAGSLOT(wtagl,11,WA_NEWLOOKMENUS,"N",-1)
  820. CALL SETTAGSLOT(wtagl,12,WA_MENUHELP,"N",-1)
  821. CALL SETTAGSLOT(wtagl,13,TAG_DONE,"N",0)
  822. win=OpenWindowTagList(portname,Null(),wtagl,0)
  823. IF pubscr~=Null() THEN
  824. DO
  825. CALL UnLockPubScreen(Null(),pubscr)
  826. pubscr=Null()
  827. END
  828. IF win=Null() THEN RETURN 5
  829. rp=GETWINDOWRASTPORT(win)
  830. dwid=GETVALUE(win,8,2,"N")-zipwid
  831. dhi=GETVALUE(win,10,2,"N")-ziphi
  832. CALL GT_RefreshWindow(win,Null())
  833. CALL SetMenuStrip(win,menu)
  834. menustrip=1
  835. zoomed=1
  836. RETURN 0
  837. messy: 
  838. IF port=0 THEN RETURN
  839. DO FOREVER
  840. msg=GetPkt(portname)
  841. IF msg=Null() THEN LEAVE
  842. msgclass=GetArg(msg,0)
  843. zipped=GETVALUE(win,10,2,"N")=ziphi
  844. IF ~Datatype(msgclass,"W") THEN
  845. CALL rx
  846. ELSE
  847. DO
  848. code=GetArg(msg,1)
  849. qual=GetArg(msg,2)
  850. gadid=GetArg(msg,9)
  851. CALL Reply(msg,0)
  852. END
  853. actgads=check.mgad & ~zipped
  854. nospiral=~check.spl
  855. IF msgclass=IDCMP_VANILLAKEY THEN
  856. DO
  857. code=C2D(Upper(D2C(code)))
  858. DO id=1 TO kgads
  859. IF code=lkey.id | code=lkey2.id THEN
  860. DO
  861. IF id=zipgad THEN
  862. DO
  863. CALL ZipWindow(win)
  864. LEAVE
  865. END
  866. ELSE
  867. IF id=depthgad THEN
  868. DO
  869. windowpos=~windowpos
  870. IF windowpos THEN
  871. CALL WindowToBack(win)
  872. ELSE
  873. CALL WindowToFront(win)
  874. LEAVE
  875. END
  876. ELSE
  877. IF id>agads+sgads THEN
  878. DO
  879. closed=id-agads
  880. LEAVE
  881. END
  882. IF ~zipped THEN
  883. DO
  884. msgclass=IDCMP_GADGETUP
  885. type=(qual//4)//3
  886. IF labs.id=0 THEN type=1
  887. IF labs.id<0 THEN type=0
  888. IF id>agads THEN type=2
  889. gadid=id*3+type
  890. IF type=2 | (actgads & ~(check.id & type=1)) THEN CALL ActivateGadget(intgad.id,win,Null())
  891. IF type=1 THEN code=~check.id
  892. IF labs.id>=0 & type=1 THEN CALL GT_SetGadgetAttrs(checkgad.id,win,Null(),GTCB_CHECKED,code)
  893. IF type=0 THEN code=(cycle.id+1)//Abs(labs.id)
  894. IF labs.id~=0 & type=0 THEN CALL GT_SetGadgetAttrs(cyclegad.id,win,Null(),GTCY_ACTIVE,code)
  895. LEAVE
  896. END
  897. END
  898. END
  899. END
  900. SELECT
  901. WHEN msgclass=IDCMP_CLOSEWINDOW THEN closed=winclose
  902. WHEN msgclass=IDCMP_MENUPICK THEN
  903. DO
  904. mnr=(code%32)//32+1
  905. n=menuoff+mnr
  906. IF mnr<=mchks THEN check.n=~check.n
  907. SELECT
  908. WHEN n=mload THEN
  909. CALL loaddef(2)
  910. WHEN n=msave THEN
  911. CALL savedef(2)
  912. WHEN n=mres THEN
  913. CALL loaddef(1)
  914. WHEN n=mdef THEN
  915. CALL loaddef(0)
  916. WHEN n=mabt THEN
  917. CALL message(0,about)
  918. WHEN n=mtext THEN
  919. IF portok THEN
  920. DO
  921. resume="BACKMESSY"
  922. errtrap=10
  923. SelectObject
  924. TextBlockPrefs "PROMPT"
  925. newtbprefs=1
  926. END
  927. WHEN n=moval THEN
  928. IF portok THEN
  929. DO
  930. resume="BACKMESSY"
  931. errtrap=10
  932. SelectObject
  933. OvalPrefs "PROMPT"
  934. END
  935. WHEN n=mnext THEN
  936. DO
  937. x=SubStr(rxport,Length(finalw)+1)
  938. i=x
  939. DO UNTIL Show("P",rxport) | i=x
  940. i=i//20+1
  941. rxport=finalw||i
  942. END
  943. IF x~=i THEN closed=nextclose
  944. END
  945. WHEN n=mrexx THEN
  946. IF lib.reqtools THEN
  947. DO
  948. i=Max(Pos(defdir,':'),LastPos('/',defdir))
  949. resume="BACKMESSY"
  950. errtrap=14
  951. newdir=RTFileRequest(SubStr(defdir,1,i),DelStr(defdir,1,i),rxfilerq,rxfileok,"RT_SCREENTOFRONT=TRUE")
  952. IF newdir~="" THEN
  953. DO
  954. defdir=newdir
  955. IF xexists("ENV:FinalWrapper") THEN 
  956. IF Open(prefs,"ENV:FinalWrapper/FWPath","W") THEN
  957. DO
  958. CALL WriteLn(prefs,defdir)
  959. CALL Close(prefs)
  960. END
  961. closed=rxclose
  962. END
  963. END
  964. WHEN n=mhelp THEN
  965. IF help THEN
  966. DO
  967. IF wb3 THEN
  968. CALL Shownode(getpubname(),docfile,"MAIN",1,0)
  969. ELSE
  970. CALL Shownode(getpubname(),docfile,"MAIN",1)
  971. CALL ScreenToFront(scr)
  972. END
  973. ELSE
  974. CALL message(0,nohelp)
  975. OTHERWISE NOP
  976. END
  977. END
  978. WHEN actgads & (msgclass=IDCMP_ACTIVEWINDOW | msgclass=IDCMP_MOUSEBUTTONS) THEN CALL ActivateGadget(intgad.1,win,Null())
  979. WHEN msgclass=IDCMP_MENUHELP | (code=95 & (msgclass=IDCMP_RAWKEY | msgclass=IDCMP_GADGETUP)) THEN
  980. IF help THEN
  981. DO
  982. mnr=(code%32)//32+1+menuoff
  983. IF msgclass=IDCMP_MENUHELP THEN
  984. node=mnode.mnr
  985. ELSE
  986. IF zipped THEN
  987. node=gnode.0
  988. ELSE 
  989. DO
  990. ymouse=getshort(C2D(win),12)
  991. xmouse=getshort(C2D(win),14)
  992. gad=GETVALUE(win,62,4,"P")
  993. id=0
  994. IF xmouse>=0 & ymouse>=0 & xmouse<dwid+zipwid & ymouse<dhi+ziphi & gad~=Null() THEN
  995. DO UNTIL gad=Null()
  996. x=getshort(C2D(gad),4)
  997. y=getshort(C2D(gad),6)
  998. w=getshort(C2D(gad),8)
  999. h=getshort(C2D(gad),10)
  1000. i=GETVALUE(gad,38,2,"N")
  1001. IF xmouse>=x & xmouse<=x+w & ymouse>=y & ymouse<=y+h & i>0 THEN
  1002. DO
  1003. id=i%3
  1004. LEAVE
  1005. END
  1006. ELSE
  1007. gad=GETVALUE(gad,0,4,"P")
  1008. END
  1009. node=gnode.id
  1010. END
  1011. IF wb3 THEN
  1012. CALL Shownode(getpubname(),docfile,node,1,0)
  1013. ELSE
  1014. CALL Shownode(getpubname(),docfile,node,1)
  1015. CALL ScreenToFront(scr)
  1016. END
  1017. ELSE
  1018. CALL message(0,nohelp)
  1019. WHEN msgclass=IDCMP_GADGETUP THEN
  1020. DO
  1021. type=gadid//3
  1022. id=gadid%3
  1023. SELECT
  1024. WHEN id>agads+sgads THEN closed=id-agads 
  1025. WHEN type=2 THEN CALL checkstrgad 
  1026. WHEN type=1 THEN  
  1027. DO
  1028. check.id=code
  1029. IF labs.id>0 & check.id~=0 & actgads THEN CALL ActivateGadget(intgad.id,win,Null())
  1030. END
  1031. OTHERWISE 
  1032. DO
  1033. cycle.id=code
  1034. check.id=1
  1035. IF labs.id>0 THEN CALL GT_SetGadgetAttrs(checkgad.id,win,Null(),GTCB_CHECKED,check.id)
  1036. IF labs.id>0 & actgads THEN CALL ActivateGadget(intgad.id,win,Null())
  1037. END
  1038. END
  1039. END
  1040. OTHERWISE NOP
  1041. END
  1042. IF check.mspl THEN
  1043. IF check.spl & nospiral THEN 
  1044. DO
  1045. cycle.adj=adjarc-1
  1046. CALL GT_SetGadgetAttrs(cyclegad.adj,win,Null(),GTCY_ACTIVE,cycle.adj)
  1047. END
  1048. END
  1049. BACKMESSY:
  1050. IF trapped THEN
  1051. DO
  1052. trapped=0
  1053. IF err=14 THEN
  1054. DO
  1055. lib.reqtools=0
  1056. CALL message(0,noreqtools)
  1057. END
  1058. END
  1059. RETURN
  1060. checkstrgad: 
  1061. old=val.id
  1062. specialinfo=GETVALUE(intgad.id,34,4,"P")
  1063. IF id>agads THEN
  1064. DO
  1065. IF gtype.id=0 THEN
  1066. val.id=GETVALUE(specialinfo,28,4,"N")
  1067. ELSE
  1068. DO
  1069. gval=GETVALUE(specialinfo,0,4,"S")
  1070. IF gtype.id=1 & gval~=old THEN
  1071. DO
  1072. IF gval~="" THEN
  1073. IF ~Datatype(replacepat(gval,",","."),"N") THEN
  1074. DO
  1075. IF closed=okclose THEN closed=0
  1076. IF closed=0 THEN CALL message(0,replacepat(notnum,"@g",ltxt.id))
  1077. END
  1078. ELSE
  1079. IF deci="COMMA" THEN
  1080. val.id=replacepat(Max(replacepat(gval,",","."),0),".",",")
  1081. ELSE
  1082. val.id=Max(replacepat(gval,",","."),0)
  1083. ELSE
  1084. val.id=""
  1085. IF val.id~=gval THEN CALL GT_SetGadgetAttrs(intgad.id,win,Null(),GTST_STRING,val.id)
  1086. END
  1087. ELSE
  1088. IF gtype.id=2 THEN val.id=gval
  1089. END
  1090. END
  1091. ELSE
  1092. DO
  1093. gval=GETVALUE(specialinfo,28,4,"N")
  1094. val.id=Max(Min(ubound.id,gval),lbound.id)
  1095. IF val.id~=gval THEN CALL GT_SetGadgetAttrs(intgad.id,win,Null(),GTIN_NUMBER,val.id)
  1096. check.id=check.id | (old~=val.id & actgads)
  1097. IF old~=val.id | actgads THEN CALL GT_SetGadgetAttrs(checkgad.id,win,Null(),GTCB_CHECKED,check.id)
  1098. END
  1099. RETURN
  1100. rx: 
  1101. PARSE VAR msgclass comm ar.1 ar.2 ar.3
  1102. arg1=Upper(ar.1)
  1103. arg2=SubStr(msgclass,Pos(ar.1,msgclass,Length(comm)+1)+Length(ar.1)+1)
  1104. IF Datatype(arg1,"U") THEN INTERPRET "id="||arg1
  1105. comm=Upper(comm)
  1106. full=msgclass
  1107. msgclass=0
  1108. ret=0
  1109. res=0
  1110. SELECT
  1111. WHEN comm="SETVAL" THEN
  1112. IF checksyntax("W") & ar.2~="" THEN
  1113. SELECT
  1114. WHEN id>0 & id<=agads THEN
  1115. IF labs.id>0 & Datatype(ar.2,"W") THEN
  1116. DO
  1117. gadid=id*3+2
  1118. msgclass=IDCMP_GADGETUP
  1119. code=0
  1120. CALL GT_SetGadgetAttrs(intgad.id,win,Null(),GTIN_NUMBER,ar.2)
  1121. res=val.id
  1122. END
  1123. WHEN id>agads & id<=agads+sgads THEN
  1124. IF Datatype(replacepat(ar.2,",","."),Word("W N A",gtype.id+1)) | gtype.id=2 THEN
  1125. DO
  1126. gadid=id*3+2
  1127. msgclass=IDCMP_GADGETUP
  1128. code=0
  1129. IF gtype.id=2 THEN
  1130. CALL GT_SetGadgetAttrs(intgad.id,win,Null(),GTST_STRING,arg2)
  1131. ELSE
  1132. IF gtype.id=1 THEN
  1133. CALL GT_SetGadgetAttrs(intgad.id,win,Null(),GTST_STRING,ar.2)
  1134. ELSE
  1135. CALL GT_SetGadgetAttrs(intgad.id,win,Null(),GTIN_NUMBER,ar.2)
  1136. res=val.id
  1137. END
  1138. OTHERWISE NOP
  1139. END
  1140. WHEN comm="SETMODE" THEN
  1141. IF checksyntax("W","w") &  id>0 & id<=agads & labs.id~=0 THEN
  1142. DO
  1143. gadid=id*3
  1144. msgclass=IDCMP_GADGETUP
  1145. code=ar.2
  1146. CALL GT_SetGadgetAttrs(cyclegad.id,win,Null(),GTCY_ACTIVE,code)
  1147. res=cycle.id
  1148. END
  1149. WHEN comm="SETSTATE" THEN
  1150. IF checksyntax("W","w") THEN
  1151. IF id>0 & id<=agads THEN
  1152. IF labs.id>=0 THEN
  1153. DO
  1154. gadid=id*3+1
  1155. msgclass=IDCMP_GADGETUP
  1156. code=(ar.2~=0)
  1157. CALL GT_SetGadgetAttrs(checkgad.id,win,Null(),GTCB_CHECKED,code)
  1158. res=check.id
  1159. END
  1160. ELSE 
  1161. DO
  1162. gadid=id*3
  1163. msgclass=IDCMP_GADGETUP
  1164. code=(ar.2~=0)
  1165. CALL GT_SetGadgetAttrs(cyclegad.id,win,Null(),GTCY_ACTIVE,code)
  1166. res=(cycle.id~=0)
  1167. END
  1168. ELSE
  1169. IF id>menuoff & id<=menuoff+mchks THEN
  1170. DO
  1171. check.id=(ar.2~=0)
  1172. CALL ClearMenuStrip(win)
  1173. item=GETVALUE(menu,18,4,"P")
  1174. DO n=menuoff+1 TO id-1
  1175. item=GETVALUE(item,0,4,"P")
  1176. END
  1177. flags=C2D(B2C(BitAnd(C2B(D2C(GETVALUE(item,12,2,"N"),2)),"1111111011111111")))+CHECKED*check.id
  1178. CALL SETVALUE(item,12,2,"N",flags,0)
  1179. CALL ResetMenuStrip(win,menu)
  1180. msgclass=-1
  1181. END
  1182. WHEN comm="GETVAL" THEN
  1183. IF checksyntax("W") & id>0 & ((id<=agads & labs.id>0) | id<=agads+sgads) THEN
  1184. DO
  1185. specialinfo=GETVALUE(intgad.id,34,4,"P")
  1186. IF id>agads & gtype.id~=0 THEN
  1187. DO
  1188. val=GETVALUE(specialinfo,0,4,"S")
  1189. IF gtype.id=1 THEN val=replacepat(val,",",".")
  1190. END
  1191. ELSE
  1192. val=GETVALUE(specialinfo,28,4,"N")
  1193. res=val
  1194. msgclass=-1
  1195. END
  1196. WHEN comm="GETMODE" THEN
  1197. IF checksyntax("W") & id>0 & id<=agads THEN
  1198. DO
  1199. res=cycle.id
  1200. msgclass=-1
  1201. END
  1202. WHEN comm="GETSTATE" THEN
  1203. IF checksyntax("W") & ((id>0 & id<=agads) | (id>menuoff & id<=menuoff+mchks)) THEN
  1204. DO
  1205. IF id>0 & id<=agads & labs.id<0 THEN 
  1206. res=(cycle.id~=0)
  1207. ELSE
  1208. res=check.id
  1209. msgclass=-1
  1210. END
  1211. WHEN comm="USE" THEN
  1212. IF checksyntax("W") THEN
  1213. IF id>=agads+sgads & id<=kgads THEN
  1214. DO
  1215. msgclass=-1
  1216. IF id=zipgad THEN
  1217. CALL ZipWindow(win)
  1218. ELSE
  1219. IF id=depthgad THEN
  1220. DO
  1221. windowpos=~windowpos
  1222. IF windowpos THEN
  1223. CALL WindowToBack(win)
  1224. ELSE
  1225. CALL WindowToFront(win)
  1226. END
  1227. ELSE
  1228. DO
  1229. msgclass=IDCMP_GADGETUP
  1230. code=0
  1231. gadid=id*3
  1232. END
  1233. END
  1234. ELSE
  1235. IF id>menuoff+mchks & id<=menuoff+mchks+macts THEN
  1236. DO
  1237. msgclass=IDCMP_MENUPICK
  1238. code=(id-1-menuoff)*32
  1239. END
  1240. WHEN comm="SETSTYLE" THEN
  1241. IF ar.1>=0 & ar.1<=Length(text) THEN
  1242. DO
  1243. msgclass=-1
  1244. IF ar.1=0 THEN 
  1245. DO
  1246. j=1
  1247. k=Length(text)
  1248. END
  1249. ELSE
  1250. DO
  1251. j=ar.1
  1252. k=j
  1253. END
  1254. y=arg2
  1255. DO i=j TO k
  1256. tprfs=specs.i
  1257. tfontp=font.i
  1258. tcolourp=colour.i
  1259. arg2=y
  1260. DO WHILE arg2~=""
  1261. x=Upper(Word(arg2,1))
  1262. v=Word(arg2,2)
  1263. SELECT
  1264. WHEN Pos(x||"|","SIZE|WIDTH|OBLIQUE|")>0 THEN
  1265. DO
  1266. p=Pos(x,tprfs)
  1267. tprfs=Left(tprfs,p-1)||x v DelWord(SubStr(tprfs,p),1,2) 
  1268. END
  1269. WHEN x="COLOR" THEN
  1270. tcolourp=x v
  1271. WHEN x="FONT" THEN
  1272. tfontp=x v
  1273. WHEN Pos(x||"|","LEADING|POSITION|CASE|STYLE|")>0 THEN NOP 
  1274. OTHERWISE msgclass=0
  1275. END
  1276. arg2=DelWord(arg2,1,2)
  1277. END
  1278. specs.i=tprfs
  1279. font.i=tfontp
  1280. colour.i=tcolourp
  1281. END
  1282. END
  1283. WHEN comm="GETSTYLE" THEN
  1284. IF ar.1>=0 & ar.1<=Length(text) THEN
  1285. DO
  1286. msgclass=-1
  1287. i=ar.1
  1288. IF i=0 THEN
  1289. DO
  1290. specs.i=defspecs
  1291. font.i=deffont
  1292. colour.i=defcolour
  1293. END
  1294. SELECT
  1295. WHEN arg2="" THEN
  1296. res=specs.i colour.i font.i
  1297. WHEN arg2="FONT" THEN
  1298. res=SubStr(font.i,6)
  1299. WHEN arg2="COLOR"THEN
  1300. res=SubStr(colour.i,7)
  1301. WHEN Pos(arg2||"|","SIZE|WIDTH|OBLIQUE|")>0 THEN
  1302. res=Word(SubStr(specs.i,Pos(arg2,specs.i)+Length(arg2)+1),1)
  1303. WHEN Pos(arg2||"|","LEADING|POSITION|CASE|STYLE|")>0 THEN 
  1304. res=Word(SubStr(defspecs,Pos(arg2,defspecs)+Length(arg2)+1),1)
  1305. OTHERWISE msgclass=0
  1306. END
  1307. IF i=0 THEN
  1308. DO
  1309. specs.i=""
  1310. font.i=""
  1311. colour.i=""
  1312. END
  1313. END
  1314. WHEN comm="SET" THEN
  1315. DO
  1316. msgclass=-1
  1317. SELECT
  1318. WHEN Abbrev("PORT",arg1,1) THEN
  1319. DO
  1320. IF Show("P",ar.2) & Left(ar.2,Length(finalw))=finalw THEN rxport=ar.2
  1321. res=rxport
  1322. END
  1323. WHEN Abbrev("SCREEN",arg1,1) THEN
  1324. DO
  1325. IF arg2="" THEN
  1326. stitle=origscrtitle
  1327. ELSE
  1328. stitle=arg2
  1329. scrtitle=replacepat(replacepat(stitle,"@f",doc),"@i",info)
  1330. CALL SetWindowTitles(win,wintitle,scrtitle)
  1331. END
  1332. WHEN Abbrev("WINDOW",arg1,1) THEN
  1333. DO
  1334. IF arg2="" THEN
  1335. wtitle=origwintitle
  1336. ELSE
  1337. wtitle=arg2
  1338. wintitle=replacepat(replacepat(wtitle,"@f",doc),"@i",info)
  1339. CALL SetWindowTitles(win,wintitle,scrtitle)
  1340. END
  1341. WHEN Abbrev("ZIP",arg1,1) THEN
  1342. DO
  1343. res=zipped
  1344. zipped=(ar.2~=0)
  1345. IF zipped~=res THEN CALL ZipWindow(win)
  1346. END
  1347. OTHERWISE msgclass=0
  1348. END
  1349. END
  1350. WHEN comm="GET" THEN
  1351. DO
  1352. msgclass=-1
  1353. SELECT
  1354. WHEN Abbrev("PORT",arg1,1) THEN
  1355. IF portok THEN
  1356. res=rxport
  1357. ELSE
  1358. res=""
  1359. WHEN Abbrev("REQTOOLS",arg1,1) THEN res=lib.reqtools
  1360. WHEN Abbrev("SCREEN",arg1,1) THEN res=scrtitle
  1361. WHEN Abbrev("VERSION",arg1,1) THEN res=version
  1362. WHEN Abbrev("WINDOW",arg1,1) THEN res=wintitle
  1363. WHEN Abbrev("ZIP",arg1,1) THEN res=zipped
  1364. OTHERWISE msgclass=0
  1365. END
  1366. END
  1367. WHEN comm="PREFS" THEN
  1368. DO
  1369. msgclass=-1
  1370. IF Abbrev("STORE",arg1,1) THEN
  1371. DO
  1372. CALL savedef(1)
  1373. prefsstore=0
  1374. END
  1375. ELSE
  1376. IF Abbrev("RESET",arg1,1) THEN
  1377. DO
  1378. CALL loaddef(1)
  1379. prefsstore=1
  1380. END
  1381. ELSE
  1382. CALL loaddef(0)
  1383. END
  1384. WHEN comm="POPFRONT" THEN
  1385. DO
  1386. IF zipped THEN CALL ZipWindow(win)
  1387. CALL WindowToFront(win)
  1388. CALL ScreenToFront(scr)
  1389. CALL ActivateWindow(win)
  1390. msgclass=-1
  1391. END
  1392. WHEN comm="DIE" THEN
  1393. DO
  1394. msgclass=-1
  1395. res=lockcnt
  1396. IF lockcnt=0 THEN
  1397. DO
  1398. CALL Reply(msg,0)
  1399. IF ar.1~="" & Datatype(ar.1,"W") THEN
  1400. IF ar.2~="" THEN
  1401. DO
  1402. CALL message(ar.1,replacepat(ar.2,"_"," "),replacepat(ar.3,"_"," "))
  1403. IF ar.1=0 THEN CALL bye(0)
  1404. END
  1405. ELSE
  1406. CALL bye(ar.1)
  1407. ELSE
  1408. CALL bye(0)
  1409. END
  1410. END
  1411. WHEN comm="MESSAGE" THEN
  1412. DO
  1413. msgclass=-1
  1414. res=message(0,replacepat(ar.1,"_"," "),replacepat(ar.2,"_"," "),replacepat(ar.3,"_"," "))
  1415. END
  1416. WHEN comm="LOCK" THEN
  1417. DO
  1418. msgclass=-1
  1419. IF Abbrev("ON",arg1,2) THEN
  1420. lockcnt=lockcnt+1
  1421. ELSE
  1422. IF Abbrev("OFF",arg1,2) THEN
  1423. lockcnt=Max(0,lockcnt-1)
  1424. ELSE
  1425. IF Abbrev("RESET",arg1,1) THEN
  1426. lockcnt=0
  1427. res=lockcnt
  1428. END
  1429. WHEN comm="ABORT" THEN
  1430. msgclass=-1
  1431. WHEN comm="GO" THEN
  1432. DO
  1433. msgclass=IDCMP_GADGETUP
  1434. code=0
  1435. gadid=okgad*3
  1436. replymsg=msg
  1437. stilltoreply=1
  1438. RETURN
  1439. END
  1440. OTHERWISE NOP
  1441. END
  1442. IF msgclass=0 THEN 
  1443. CALL Reply(msg,5)
  1444. ELSE
  1445. CALL Reply(msg,ret,res)
  1446. IF msgclass=0 THEN CALL message(0,replacepat(rxcmderr,"@c",full))
  1447. RETURN
  1448. quickmessy: 
  1449. IF port=0 THEN RETURN 0
  1450. DO FOREVER
  1451. msg=GetPkt(portname)
  1452. IF msg=Null() THEN LEAVE
  1453. msgclass=GetArg(msg,0)
  1454. IF msgclass=IDCMP_CLOSEWINDOW THEN
  1455. closed=winclose
  1456. ELSE
  1457. IF msgclass=IDCMP_CHANGEWINDOW THEN
  1458. IF ~BitTst(D2C(GETVALUE(win,24,4,"N")),28) THEN CALL ZipWindow(win) 
  1459. IF Datatype(msgclass,"W") THEN
  1460. CALL Reply(msg,0)
  1461. ELSE
  1462. IF Upper(msgclass)="ABORT" THEN
  1463. DO
  1464. closed=winclose
  1465. CALL Reply(msg,0)
  1466. END
  1467. ELSE
  1468. CALL Reply(msg,1)
  1469. END
  1470. RETURN closed~=0
  1471. guiclean: 
  1472. IF cleangui THEN
  1473. DO
  1474. IF pubscr~=Null() THEN CALL UnLockPubScreen(Null(),pubscr)
  1475. IF win~=Null() THEN
  1476. DO
  1477. IF menustrip THEN CALL ClearMenuStrip(win)
  1478. CALL CloseWindow(win)
  1479. END
  1480. IF menu~=Null() THEN CALL FreeMenus(menu)
  1481. IF gad~=Null() THEN CALL FreeGadgets(gad)
  1482. IF scrvinfo~=Null() THEN CALL FreeVisualInfo(scrvinfo)
  1483. IF port THEN CALL ClosePort(portname)
  1484. port=0
  1485. DO id=1 TO gads
  1486. CALL FREETHIS(newgadx.id)
  1487. CALL FREETHIS(newgadxi.id)
  1488. CALL FREETHIS(newgadxb.id)
  1489. CALL FREETHIS(glabels.id)
  1490. END
  1491. CALL FREETHIS(newgadbv)
  1492. CALL FREETHIS(mptr)
  1493. CALL FREETHIS(wtagl)
  1494. CALL FREETHIS(glistptr)
  1495. CALL FREETHIS(pubnptr)
  1496. cleangui=0
  1497. END
  1498. RETURN
  1499. options: 
  1500. GetTextBlockPrefs "TEXTFLOW FLOWDIST TEXT"
  1501. PARSE VAR RESULT defflow deffld deftext
  1502. defprfs=""
  1503. IF defflow~="" THEN defprfs=defprfs "TEXTFLOW" defflow
  1504. IF deffld~="" THEN defprfs=defprfs "FLOWDIST" deffld
  1505. IF deftext~="" THEN defprfs=defprfs "TEXT" deftext
  1506. GetTextBlockTypePrefs "SIZE LEADING WIDTH OBLIQUE POSITION CASE STYLE COLOR FONT"
  1507. PARSE VAR RESULT tsize tlead twid tobl tpos tcase tstyl tcol tfont
  1508. defspecs="SIZE" tsize "LEADING" tlead "WIDTH" twid "OBLIQUE" tobl "POSITION" tpos "CASE" tcase "STYLE" tstyl
  1509. defcolour="COLOR" tcol
  1510. IF Left(tfont,1)~=" " THEN tfont=" "||tfont 
  1511. deffont="FONT"||tfont
  1512. ssize=360
  1513. start="+0"
  1514. Status "PAGES"
  1515. docpages=RESULT
  1516. IF val.xgad~="" THEN ovalx=replacepat(val.xgad,",",".")
  1517. IF val.ygad~="" THEN ovaly=replacepat(val.ygad,",",".")
  1518. IF val.wgad~="" THEN ovalw=replacepat(val.wgad,",",".")
  1519. IF val.hgad~="" THEN ovalh=replacepat(val.hgad,",",".")
  1520. IF val.pgad~=0 THEN ovalp=Min(Max(val.pgad,1),docpages)
  1521. IF Left(text,Min(len.tgad,Length(text)))~=val.tgad THEN
  1522. DO
  1523. text=val.tgad
  1524. gadgettext=1
  1525. virtualtext=1
  1526. END
  1527. rescan=Length(text)=0
  1528. IF check.arc THEN ssize=SubStr("+-",cycle.arc+1,1)||val.arc
  1529. IF check.beg THEN start=SubStr(" -+",cycle.beg+1,1)||val.beg
  1530. titlemd=check.rot & (cycle.rot=3)
  1531. norrot=~check.rot | titlemd
  1532. IF norrot THEN
  1533. rrot=""
  1534. ELSE
  1535. IF cycle.rot=0 THEN
  1536. rrot=val.rot
  1537. ELSE
  1538. rrot=SubStr("-+",cycle.rot//2+1,1)||val.rot
  1539. dordim=check.spl
  1540. rdim=""
  1541. IF check.spl THEN rdim=SubStr("+-",cycle.spl+1,1)||val.spl
  1542. dohdim=check.siz | check.spl
  1543. hdim=""
  1544. IF check.siz THEN
  1545. hdim=SubStr("+-",cycle.siz+1,1)||val.siz
  1546. ELSE
  1547. IF check.spl THEN hdim=rdim
  1548. doresize=check.zoo
  1549. IF check.zoo THEN
  1550. DO
  1551. resize=val.zoo
  1552. resizek=SubStr("+|-",cycle.zoo+1,1)
  1553. END
  1554. adjust=cycle.adj
  1555. doadj=(adjust>0)
  1556. fillcol=cycle.ink//2
  1557. shadow=cycle.ink=3 | cycle.ink=4
  1558. resetcol=(cycle.ink=0) | shadow
  1559. attr=check.pat
  1560. wordmd=cycle.wrd>0
  1561. wordoff=SubStr(" 0 0+1-1",2*cycle.wrd+1,2)
  1562. charmd=~wordmd
  1563. IF ssize=0 THEN ssize=0.01 
  1564. absstart=0
  1565. IF Verify(Left(start,1),"+-","m")=0 THEN
  1566. DO
  1567. absstart=1
  1568. start=Max(Min(start,360),0)
  1569. END
  1570. ELSE
  1571. start=Max(Min(start,360),-360)
  1572. IF dordim THEN
  1573. rdim=Max(Min(rdim,100),-100)
  1574. ELSE
  1575. ssize=Max(Min(ssize,360),-360)
  1576. IF rdim=0 THEN rdim=0.01
  1577. IF dohdim THEN
  1578. hdim=Max(Min(hdim,100),-100)
  1579. ELSE
  1580. hdim=rdim
  1581. IF hdim=0 THEN hdim=0.01
  1582. IF doresize THEN
  1583. DO
  1584. resizex=Max(Min(resize,1000),5)/100
  1585. resizey=resizex
  1586. resize=resizex
  1587. IF resizek="|" THEN
  1588. resizex=1
  1589. ELSE
  1590. IF resizek="-" THEN resizey=1
  1591. END
  1592. drot=0
  1593. dodrot=0
  1594. IF rrot~="" THEN
  1595. IF Verify(Left(rrot,1),"+-","m")>0 THEN
  1596. DO
  1597. drot=Max(Min(rrot,360),-360)
  1598. rrot=""
  1599. norrot=1
  1600. END
  1601. ELSE
  1602. rrot=Max(Min(rrot,360),0)
  1603. RETURN
  1604. chosenobjs: 
  1605. ovalrescan=0
  1606. txtrescan=0
  1607. txt=0
  1608. oval=0
  1609. len=0
  1610. FirstObject "SELECTED"
  1611. o=RESULT
  1612. IF o~=0 THEN
  1613. DO
  1614. cnt=0
  1615. DO UNTIL o=0
  1616. gobj.cnt=o
  1617. NextObject o "SELECTED"
  1618. o=RESULT
  1619. cnt=cnt+1
  1620. END
  1621. DO i=0 TO cnt-1 WHILE oval=0 | txt=0
  1622. GetObjectType gobj.i
  1623. IF RESULT=7 THEN txt=gobj.i
  1624. IF RESULT=6 THEN oval=gobj.i
  1625. END
  1626. END
  1627. IF oval=0 THEN
  1628. oval=oldoval
  1629. ELSE
  1630. ovalrescan=1
  1631. IF gadgettext THEN len=Length(text)
  1632. IF gadgettext & ~(init | rescan) THEN txt=0
  1633. CALL getattr
  1634. Status "PARAPOS"
  1635. pos=RESULT
  1636. PARSE VAR pos para ppos x
  1637. Status "PARACHARS"
  1638. plen=RESULT
  1639. IF txt=0 & ~newattr THEN
  1640. IF Words(pos)=4  & (~gadgettext | rescan | init) THEN
  1641. DO
  1642. Extract
  1643. text=RESULT
  1644. len=Length(text)
  1645. IF C2X(Right(text,1))="0A" THEN len=len-1 
  1646. text=""
  1647. MoveToPara para ppos
  1648. virtualtext=0
  1649. ppos=0
  1650. END
  1651. ELSE
  1652. IF plen~=0 & (rescan | ((plen~=oldplen | para~=oldpara | ppos~=oldppos) & ~gadgettext)) THEN
  1653. DO
  1654. len=plen
  1655. text=""
  1656. virtualtext=0
  1657. IF ppos~=0 THEN MoveToPara para 0
  1658. ppos=0
  1659. END
  1660. IF txt>0 THEN
  1661. DO
  1662. GetTextBlockText txt
  1663. text=RESULT
  1664. len=Length(text)
  1665. END
  1666. IF len=0 & text~="" THEN
  1667. DO
  1668. objs=oldobjs
  1669. len=oldlen
  1670. END
  1671. ELSE
  1672. txtrescan=1
  1673. IF (len=0 | oval=0) & ~init THEN
  1674. DO
  1675. IF len=0 & text~="" THEN
  1676. DO
  1677. len=Length(text)
  1678. txtrescan=1
  1679. END
  1680. IF oval=0 & ovalx~="" & ovaly~="" & ovalw~="" & ovalh~="" & ovalp~="" THEN oval=-1
  1681. IF len=0 | oval=0 THEN
  1682. DO
  1683. CALL message(0,noselect)
  1684. RETURN 5
  1685. END
  1686. END
  1687. gadgettext=0
  1688. oldoval=oval
  1689. oldtxt=txt
  1690. oldlen=len
  1691. oldobjs=objs
  1692. oldpara=para
  1693. oldppos=ppos
  1694. oldplen=plen
  1695. redrawchars=1
  1696. RETURN 0
  1697. getattr: 
  1698. newattr=0
  1699. IF ~attr | init THEN RETURN 5
  1700. Status "PARAPOS"
  1701. pos=RESULT
  1702. IF Words(pos)~=4 THEN RETURN 5
  1703. PARSE VAR pos para ppos x
  1704. Extract
  1705. atext=RESULT
  1706. MoveToPara para ppos
  1707. alen=Length(atext)
  1708. IF C2X(Right(atext,1))="0A" THEN alen=alen-1 
  1709. IF alen=0 THEN RETURN 5
  1710. DO i=1 TO alen
  1711. Cursor "RIGHT"
  1712. aspecs.i=gettexttypespecs()
  1713. Status "FONTPATH"
  1714. afont.i="FONT" RESULT
  1715. Status "FONTCOLOR"
  1716. acolour.i="COLOR" RESULT
  1717. IF quickmessy() THEN
  1718. DO
  1719. CALL remobjs
  1720. oldlen=0
  1721. alen=0
  1722. oldobjs=0
  1723. RETURN 5
  1724. END
  1725. END
  1726. MoveToPara para 0
  1727. oldppos=0
  1728. oldpara=para
  1729. Status "PARACHARS"
  1730. oldplen=RESULT
  1731. newattr=1
  1732. RETURN 0
  1733. oval: 
  1734. IF ovalrescan THEN
  1735. DO
  1736. GetObjectRotation oval
  1737. orot=RESULT
  1738. IF orot~=0 THEN SetObjectRotation oval 0
  1739. GetObjectCoords oval
  1740. PARSE VAR RESULT ovalp ovalx ovaly ovalw ovalh
  1741. IF ovalw<0 THEN
  1742. DO
  1743. ovalx=ovalx+ovalw
  1744. ovalw=-ovalw
  1745. END
  1746. IF ovalh<0 THEN
  1747. DO
  1748. ovaly=ovaly+ovalh
  1749. ovalh=-ovalh
  1750. END
  1751. val.xgad=Left(ovalx,Min(len.xgad,Length(ovalx)))
  1752. val.ygad=Left(ovaly,Min(len.ygad,Length(ovaly)))
  1753. val.wgad=Left(ovalw,Min(len.wgad,Length(ovalw)))
  1754. val.hgad=replacepat(Left(ovalh,Min(len.hgad,Length(ovalh)))," ","") 
  1755. val.pgad=Left(ovalp,Min(len.pgad,Length(ovalp)))
  1756. IF deci="COMMA" THEN
  1757. DO
  1758. val.xgad=replacepat(val.xgad,".",",")
  1759. val.ygad=replacepat(val.ygad,".",",")
  1760. val.wgad=replacepat(val.wgad,".",",")
  1761. val.hgad=replacepat(val.hgad,".",",")
  1762. END
  1763. IF cleangui THEN
  1764. DO
  1765. CALL GT_SetGadgetAttrs(intgad.xgad,win,Null(),GTST_STRING,val.xgad)
  1766. CALL GT_SetGadgetAttrs(intgad.ygad,win,Null(),GTST_STRING,val.ygad)
  1767. CALL GT_SetGadgetAttrs(intgad.wgad,win,Null(),GTST_STRING,val.wgad)
  1768. CALL GT_SetGadgetAttrs(intgad.hgad,win,Null(),GTST_STRING,val.hgad)
  1769. CALL GT_SetGadgetAttrs(intgad.pgad,win,Null(),GTIN_NUMBER,val.pgad)
  1770. END
  1771. GetObjectParams oval "TEXTFLOW FLOWDIST LINECOLOR FILLCOLOR"
  1772. PARSE VAR RESULT flow fld ovlcol ovfcol
  1773. IF Left(flow,5)="Right" THEN
  1774. flow="Right"
  1775. ELSE
  1776. IF Left(flow,4)="Left" THEN flow="Left"
  1777. IF doresize THEN SetObjectCoords oval x+rx*(1-resizex) y+ry*(1-resizey) rx*resizex*2 ry*resizey*2
  1778. ovalscanned=1
  1779. END
  1780. IF oval~=0 THEN
  1781. DO
  1782. GetPageSetup "WIDTH" "HEIGHT"
  1783. PARSE VAR RESULT pagew pageh
  1784. rx=ovalw/2
  1785. ry=ovalh/2
  1786. xm=Min(ovalx,pagew)+rx
  1787. ym=Min(ovaly,pageh)+ry
  1788. page=ovalp
  1789. END
  1790. IF ~ovalscanned THEN 
  1791. DO
  1792. GetOvalPrefs "TEXTFLOW FLOWDIST LINECOLOR FILLCOLOR"
  1793. PARSE VAR RESULT flow fld ovlcol ovfcol
  1794. IF Left(flow,5)="Right" THEN
  1795. flow="Right"
  1796. ELSE
  1797. IF Left(flow,4)="Left" THEN flow="Left"
  1798. orot=0
  1799. END
  1800. IF fillcol THEN
  1801. ovcol=ovfcol
  1802. ELSE
  1803. ovcol=ovlcol
  1804. TextBlockPrefs "TEXTFLOW" flow "FLOWDIST" fld
  1805. IF ~resetcol THEN TextBlockTypePrefs "COLOR" ovcol
  1806. RETURN
  1807. text: 
  1808. usesheet=alen>0 & attr
  1809. IF ~(newtbprefs | txtrescan | dirtysize | (sheetused ^ usesheet) | newattr) THEN RETURN
  1810. DO i=1 TO len
  1811. x=SubStr(text,i,1)
  1812. IF usesheet THEN 
  1813. DO
  1814. attrn=(i-1)//alen+1
  1815. TextBlockTypePrefs afont.attrn
  1816. base.i=getbase(afont.attrn)
  1817. IF resetcol THEN
  1818. TextBlockTypePrefs aspecs.attrn acolour.attrn
  1819. ELSE
  1820. TextBlockTypePrefs aspecs.attrn
  1821. END
  1822. ELSE
  1823. DO
  1824. IF newtbprefs THEN
  1825. DO
  1826. specs.i=defspecs
  1827. font.i=deffont
  1828. colour.i=defcolour
  1829. END
  1830. j=i-1
  1831. IF font.i~=font.j THEN
  1832. DO
  1833. TextBlockTypePrefs font.i
  1834. base.i=getbase(font.i)
  1835. END
  1836. ELSE
  1837. base.i=base.j
  1838. IF resetcol & (colour.i~=colour.j) THEN
  1839. TextBlockTypePrefs specs.i colour.i
  1840. ELSE
  1841. IF specs.i~=specs.j THEN TextBlockTypePrefs specs.i
  1842. END
  1843. IF Verify(x,'";= ',"M")  THEN x='"'||x||'"'
  1844. DrawTextBlock page xm ym x
  1845. obj.i=RESULT
  1846. objs=objs+1
  1847. IF check.mrel THEN Redraw
  1848. GetObjectCoords
  1849. PARSE VAR RESULT x x x objw.objs objh.objs
  1850. IF quickmessy() THEN
  1851. DO
  1852. CALL remobjs
  1853. dirtysize=1
  1854. oldlen=0
  1855. oldobjs=0
  1856. RETURN
  1857. END
  1858. END
  1859. sheetused=usesheet 
  1860. dirtysize=0
  1861. newtbprefs=0
  1862. redrawchars=0
  1863. RETURN
  1864. scan: 
  1865. IF ~(txtrescan | dirtytext) | len=0 THEN RETURN
  1866. IF txt>0 THEN
  1867. DO
  1868. redrawchars=0
  1869. GetObjectTypeSpecs txt "SIZE LEADING WIDTH OBLIQUE POSITION CASE STYLE COLOR FONT"
  1870. PARSE VAR RESULT tsize tlead twid tobl tpos tcase tstyl tcol tfont
  1871. prfs="SIZE" tsize "LEADING" tlead "WIDTH" twid "OBLIQUE" tobl "POSITION" tpos "CASE" tcase "STYLE" tstyl
  1872. colourp="COLOR" tcol
  1873. IF Left(tfont,1)~=" " THEN tfont=" "||tfont 
  1874. fontp="FONT"||tfont
  1875. GetObjectRotation txt
  1876. txtrot=RESULT
  1877. virtualtext=0
  1878. DO i=1 TO len
  1879. specs.i=prfs
  1880. font.i=fontp
  1881. colour.i=colourp
  1882. END
  1883. END
  1884. ELSE
  1885. IF virtualtext THEN
  1886. DO i=1 TO len
  1887. specs.i=defspecs
  1888. font.i=deffont
  1889. colour.i=defcolour
  1890. END
  1891. ELSE
  1892. IF text="" | dirtytext THEN
  1893. DO
  1894. text=""
  1895. DO i=1 TO len
  1896. Extract
  1897. x=rembad(RESULT)
  1898. text=text||x
  1899. Cursor "RIGHT"
  1900. specs.i=gettexttypespecs()
  1901. Status "FONTPATH"
  1902. font.i="FONT" RESULT
  1903. Status "FONTCOLOR"
  1904. colour.i="COLOR" RESULT
  1905. IF quickmessy() THEN
  1906. DO
  1907. CALL remobjs
  1908. oldlen=0
  1909. dirtytext=1
  1910. oldobjs=0
  1911. RETURN
  1912. END
  1913. END
  1914. MoveToPara para 0
  1915. val.tgad=Left(text,Min(len.tgad,Length(text)))
  1916. IF cleangui THEN CALL GT_SetGadgetAttrs(intgad.tgad,win,Null(),GTST_STRING,val.tgad)
  1917. END
  1918. dirtytext=0
  1919. IF text~="" THEN
  1920. DO
  1921. IF C2X(Right(text,1))="0A" THEN
  1922. DO
  1923. len=len-1
  1924. text=Left(text,len)
  1925. END
  1926. text=rembad(text)
  1927. old=val.tgad
  1928. val.tgad=Left(text,Min(len.tgad,Length(text)))
  1929. IF cleangui & val.tgad~=old THEN CALL GT_SetGadgetAttrs(intgad.tgad,win,Null(),GTST_STRING,val.tgad)
  1930. END
  1931. RETURN
  1932. initwrap: 
  1933. txtw=0
  1934. wnr=1
  1935. wordbeg=1
  1936. wordw=0
  1937. IF wordmd THEN
  1938. DO
  1939. wn=1
  1940. whi.wn=0
  1941. DO n=1 TO len
  1942. whi.wn=Max(objh.n,whi.wn)
  1943. IF SubStr(text,n,1)=" " | n=len THEN
  1944. DO
  1945. txtw=txtw+whi.wn
  1946. wn=wn+1
  1947. whi.wn=0
  1948. END
  1949. END
  1950. END
  1951. ELSE
  1952. DO n=1 TO len
  1953. txtw=txtw+objw.n
  1954. END
  1955. PI=3.141593
  1956. deg2rad=PI/180
  1957. smin=0.1 
  1958. rx=Max(rx,smin)
  1959. ry=Max(ry,smin)
  1960. sizerad=ssize*deg2rad
  1961. angstep=sizerad/txtw
  1962. IF doresize THEN angstep=angstep/resize
  1963. IF absstart THEN
  1964. angstart=start*deg2rad
  1965. ELSE
  1966. angstart=(ssize-360+start*2)/2*deg2rad
  1967. adone=angstart
  1968. flip=Sign(ssize)
  1969. ssize=ssize<0
  1970. fr=0
  1971. IF dordim THEN
  1972. DO
  1973. fr=(1-Abs(rdim)/100)/sizerad*Sign(rdim)
  1974. IF rdim<0 THEN
  1975. fr0=Abs(rdim)/100
  1976. ELSE
  1977. fr0=1
  1978. END
  1979. ELSE
  1980. qr=1
  1981. IF dohdim THEN
  1982. DO
  1983. fh=(1-Abs(hdim)/100)/sizerad*Sign(hdim)
  1984. IF hdim<0 THEN
  1985. fh0=Abs(hdim)/100
  1986. ELSE
  1987. fh0=1
  1988. END
  1989. ELSE
  1990. qh=1
  1991. wdone=0
  1992. o=0
  1993. rxx=rx
  1994. ryy=ry
  1995. IF doresize THEN
  1996. DO
  1997. rxx=rxx*resizex
  1998. ryy=ryy*resizey
  1999. END
  2000. sobjs=0
  2001. IF titlemd THEN
  2002. DO
  2003. CALL remobjs
  2004. redrawchars=1
  2005. END
  2006. resetprefs=redrawchars | shadow
  2007. recalcchar=resetprefs | wordmd
  2008. usesheet=(alen>0) & attr
  2009. RETURN
  2010. wrap: 
  2011. CALL initwrap
  2012. DO n=1 TO len
  2013. IF recalcchar THEN
  2014. DO
  2015. char=SubStr(text,n,1)
  2016. IF Verify(char,'";= ',"M")  THEN char='"'||char||'"'
  2017. END
  2018. cw=objw.n
  2019. ch=objh.n
  2020. o=obj.n
  2021. IF resetprefs THEN
  2022. DO
  2023. IF usesheet THEN
  2024. DO
  2025. attrn=(n-1)//alen+1
  2026. TextBlockTypePrefs afont.attrn
  2027. base.n=getbase(afont.attrn)
  2028. IF resetcol THEN
  2029. TextBlockTypePrefs aspecs.attrn acolour.attrn
  2030. ELSE
  2031. TextBlockTypePrefs aspecs.attrn
  2032. END
  2033. ELSE
  2034. DO
  2035. m=n-1
  2036. IF font.n~=font.m THEN
  2037. DO
  2038. TextBlockTypePrefs font.n
  2039. base.n=getbase(font.n)
  2040. END
  2041. ELSE
  2042. base.n=base.m
  2043. IF resetcol & (colour.n~=colour.m | shadow) THEN
  2044. TextBlockTypePrefs specs.n colour.n
  2045. ELSE
  2046. IF specs.n~=specs.m THEN TextBlockTypePrefs specs.n
  2047. END
  2048. END
  2049. IF charmd THEN
  2050. DO
  2051. CALL position
  2052. m=n-1
  2053. base=base.n*cw/objw.n
  2054. x=rxx*Sin(f)*qr-cw/2+base*Sin(crot*deg2rad)
  2055. y=ryy*Cos(f)*qr+base*(1-Cos(crot*deg2rad))
  2056. END
  2057. IF titlemd THEN
  2058. DO
  2059. PARSE VAR specs.n "WIDTH" l
  2060. l=Word(l,1)*cw/objw.n
  2061. i=crot+45
  2062. k=(i-i//90)//360
  2063. j=45-i//360+k
  2064. i=X2D(SubStr(obl,Abs(j)+1,1))
  2065. crot=(360+k-Sign(j)*SubStr(obrot,i+i+1,2))//360
  2066. TextBlockTypePrefs "OBLIQUE" Trunc(10*i*Sign(j)/Sqrt(l)+0.5)
  2067. END
  2068. IF wordmd THEN
  2069. DO
  2070. x=wordw
  2071. y=(whi.wnr-objh.n)/2
  2072. wordw=wordw+objw.n
  2073. crot=0
  2074. END
  2075. IF redrawchars THEN
  2076. DO
  2077. DrawTextBlock page x+xm y+ym char
  2078. obj.n=RESULT
  2079. objs=objs+1
  2080. IF check.mrel THEN Redraw
  2081. o=obj.n
  2082. IF cw~=objw.n | ch~=objh.n THEN SetObjectCoords o page x+xm y+ym cw ch
  2083. END
  2084. ELSE
  2085. SetObjectCoords o page x+xm y+ym cw ch
  2086. SetObjectRotation o crot
  2087. IF shadow THEN
  2088. DO
  2089. TextBlockTypePrefs "COLOR" ovcol
  2090. DrawTextBlock page x+xm+rx/10 y+ym+ry/10 char
  2091. sobj.n=RESULT
  2092. sobjs=sobjs+1
  2093. IF check.mrel THEN Redraw
  2094. IF cw~=objw.n | ch~=objh.n THEN SetObjectCoords sobj.n page x+xm+rx/10 y+ym+ry/10 cw ch
  2095. SetObjectRotation sobj.n crot
  2096. END
  2097. IF wordmd THEN
  2098. IF char='" "' | n=len THEN CALL endofword
  2099. IF quickmessy() THEN
  2100. DO
  2101. CALL remobjs
  2102. RETURN
  2103. END
  2104. END
  2105. RETURN
  2106. getbase: 
  2107. ARG font
  2108. base=-1
  2109. DO ii=1 TO ftabsize
  2110. IF font=ftab.ii THEN base=fbase.ii
  2111. END
  2112. IF base=-1 THEN
  2113. DO
  2114. DrawTextBlock page xm ym "W"
  2115. o=RESULT
  2116. SetObjectRotation o 90
  2117. GetObjectCoords o
  2118. PARSE VAR RESULT op ox oy ow oh
  2119. DeleteObject o
  2120. base=Abs(oy-ym)-ow/2
  2121. ftabsize=ftabsize+1
  2122. ftab.ftabsize=font
  2123. fbase.ftabsize=base
  2124. END
  2125. RETURN base
  2126. position: 
  2127. IF doresize THEN
  2128. DO
  2129. cw=cw*resize
  2130. ch=ch*resize
  2131. END
  2132. f=angstart-angstep*(wdone+cw/2)
  2133. wdone=wdone+cw
  2134. IF dordim THEN qr=fr0+fr*(f-angstart)
  2135. IF dohdim THEN
  2136. DO
  2137. qh=fh0+fh*(f-angstart)
  2138. ch=Max(ch*qh,smin)
  2139. cw=Max(cw*qh,smin)
  2140. END
  2141. IF doadj THEN
  2142. IF adjust=4 THEN
  2143. DO
  2144. asize=1.1*cw/radius(adone,rxx,ryy,qr)
  2145. f=adone-asize/2*flip
  2146. adone=adone-asize*flip
  2147. END
  2148. ELSE
  2149. DO
  2150. carc=radius(f,rxx,ryy,qr)*angstep/qr
  2151. IF adjust=1 THEN ch=ch*carc
  2152. IF adjust=3 THEN ch=ch/Sqrt(carc)
  2153. cw=cw*carc
  2154. END
  2155. IF norrot THEN
  2156. crot=720-Trunc(Atan(ryy/rxx*Tan(f))/PI*180)+180*((Cos(f)>0)+ssize)+drot
  2157. ELSE
  2158. crot=rrot
  2159. crot=crot//360
  2160. RETURN
  2161. endofword: 
  2162. remspc=(char='" "')
  2163. IF remspc THEN wordw=wordw-objw.n
  2164. cw=whi.wnr
  2165. ch=1
  2166. CALL position
  2167. x=rxx*Sin(f)*qr-wordw/2
  2168. y=ryy*Cos(f)*qr-whi.wnr
  2169. x=x+wordoff*wordw/2*Sin(crot*deg2rad)
  2170. y=y-wordoff*wordw/2*Cos(crot*deg2rad)
  2171. crot=(crot+270)//360
  2172. IF shadow THEN
  2173. DO
  2174. SelectObject
  2175. DO i=wordbeg TO n
  2176. SelectObject sobj.i "MULTIPLE"
  2177. END
  2178. Group
  2179. CurrentObject
  2180. wsobj.wnr=RESULT
  2181. GetObjectCoords
  2182. SetObjectCoords wsobj.wnr page x+xm+rx/10 y+ym+ry/10 Word(RESULT,4)*ch Word(RESULT,5)*cw/whi.wnr
  2183. SetObjectRotation wsobj.wnr crot
  2184. END
  2185. SelectObject
  2186. DO i=wordbeg TO n-remspc
  2187. SelectObject obj.i "MULTIPLE"
  2188. END
  2189. Group
  2190. CurrentObject
  2191. wobj.wnr=RESULT
  2192. GetObjectCoords
  2193. SetObjectCoords wobj.wnr page x+xm y+ym Word(RESULT,4)*ch Word(RESULT,5)*cw/whi.wnr
  2194. SetObjectRotation wobj.wnr crot
  2195. IF remspc THEN DeleteObject obj.n
  2196. wordbeg=n+1
  2197. wnr=wnr+1
  2198. wordw=0
  2199. RETURN
  2200. group: 
  2201. SelectObject
  2202. IF wordmd THEN
  2203. DO n=1 TO wnr-1
  2204. SelectObject wobj.n "MULTIPLE"
  2205. END
  2206. ELSE
  2207. DO n=1 TO objs
  2208. SelectObject obj.n "MULTIPLE"
  2209. END
  2210. Group
  2211. i=RESULT
  2212. objs=0
  2213. IF orot~=0 THEN SetObjectRotation 0 orot
  2214. IF shadow THEN
  2215. DO
  2216. SelectObject
  2217. IF wordmd THEN
  2218. DO n=1 TO wnr-1
  2219. SelectObject wsobj.n "MULTIPLE"
  2220. END
  2221. ELSE
  2222. DO n=1 TO sobjs
  2223. SelectObject sobj.n "MULTIPLE"
  2224. END
  2225. Group
  2226. sobjs=0
  2227. IF orot~=0 THEN SetObjectRotation 0 orot
  2228. ObjectToBack 0
  2229. END
  2230. Redraw
  2231. RETURN
  2232. bye: 
  2233. PARSE ARG errnr
  2234. errtrap=-2
  2235. IF errnr=0 & lockcnt>0 THEN RETURN
  2236. IF stilltoreply THEN CALL Reply(replymsg,10)
  2237. IF catalog~=0 THEN CALL CloseCatalog(catalog)
  2238. CALL resetprefs
  2239. CALL guiclean
  2240. CALL remobjs
  2241. IF errnr>0 THEN 
  2242. DO
  2243. IF xexists(bugreport) THEN
  2244. DO
  2245. IF errormsg="" THEN errormsg="Error #"||errnr
  2246. ADDRESS COMMAND "Rx" bugreport version errormsg
  2247. END
  2248. END
  2249. EXIT errnr
  2250. RETURN
  2251. remobjs: 
  2252. IF objs>0 THEN
  2253. DO
  2254. IF wordmd THEN
  2255. DO n=1 TO wnr-1
  2256. SelectObject wobj.n
  2257. UnGroup
  2258. END
  2259. SelectObject
  2260. DO n=1 TO objs
  2261. SelectObject obj.n "MULTIPLE"
  2262. END
  2263. Group
  2264. DeleteObject
  2265. objs=0
  2266. END
  2267. IF sobjs>0 THEN
  2268. DO
  2269. SelectObject
  2270. IF wordmd THEN
  2271. DO n=1 TO wnr-1
  2272. SelectObject wsobj.n
  2273. UnGroup
  2274. END
  2275. DO n=1 TO sobjs
  2276. SelectObject sobj.n "MULTIPLE"
  2277. END
  2278. Group
  2279. DeleteObject
  2280. sobjs=0
  2281. END
  2282. RETURN
  2283. resetprefs: 
  2284. IF deci~="" THEN DocItemPrefs "DECIMAL PERIOD"
  2285. IF defprfs~="" THEN TextBlockPrefs defprfs
  2286. IF defspecs~="" | defcolour~="" THEN TextBlockTypePrefs defspecs defcolour
  2287. IF deffont~="" THEN TextBlockTypePrefs deffont
  2288. IF deci~="" THEN DocItemPrefs "DECIMAL" deci
  2289. RETURN
  2290. loaddef: 
  2291. ARG where
  2292. CALL loadtemp
  2293. IF where>0 THEN
  2294. DO
  2295. ok=0
  2296. DO i=where TO 3-where BY 3-where*2 UNTIL ok
  2297. IF preff.i~="" THEN
  2298. DO
  2299. ok=Open(prefs,preff.i,"R")
  2300. IF ok THEN
  2301. DO
  2302. default=ReadCh(prefs,prefsize+6)
  2303. CALL Close(prefs)
  2304. END
  2305. END
  2306. END
  2307. END
  2308. ELSE
  2309. default=""
  2310. IF Length(default)~=prefsize+6 | Left(default,6)~=prefsid | C2D(SubStr(default,5,2))~=prefsize THEN default=""
  2311. IF default="" THEN 
  2312. DO
  2313. winx=defwinx
  2314. winy=defwiny
  2315. DO id=1 TO agads
  2316. check.id=defchk.id
  2317. cycle.id=defcyc.id
  2318. val.id=defval.id
  2319. END
  2320. DO id=menuoff+1 TO menuoff+mchks
  2321. check.id=defchk.id
  2322. END
  2323. DO id=agads+1 TO agads+sgads
  2324. IF gtype.id=0 THEN
  2325. val.id=1
  2326. ELSE
  2327. val.id=""
  2328. END
  2329. END
  2330. ELSE 
  2331. DO
  2332. winx=C2D(SubStr(default,7,2))
  2333. winy=C2D(SubStr(default,9,2))
  2334. DO id=1 TO agads
  2335. i=id*4
  2336. check.id=C2D(SubStr(default,i+7,1))~=0
  2337. cycle.id=Min(Max(C2D(SubStr(default,i+8,1)),0),Abs(labs.id))
  2338. val.id=Min(Max(C2D(SubStr(default,i+9,2)),0),9999)
  2339. END
  2340. DO id=menuoff+1 TO menuoff+mchks
  2341. check.id=C2D(SubStr(default,id+agads*4-menuoff+10,1))~=0
  2342. END
  2343. END
  2344. CALL updategadgets
  2345. RETURN
  2346. savedef: 
  2347. ARG where
  2348. CALL savetemp
  2349. winx=GETVALUE(win,4,2,"N")
  2350. winy=GETVALUE(win,6,2,"N")
  2351. default=prefsid||D2C(winx,2)||D2C(winy,2)
  2352. DO id=1 TO agads
  2353. default=default||D2C(check.id,1)||D2C(cycle.id,1)||D2C(val.id,2)
  2354. END
  2355. DO id=menuoff+1 TO menuoff+mchks
  2356. default=default||D2C(check.id,1)
  2357. END
  2358. DO i=1 TO where
  2359. IF preff.i~="" THEN
  2360. DO
  2361. ok=Open(prefs,preff.i,"W")
  2362. IF ok THEN
  2363. DO
  2364. CALL WriteCh(prefs,default)
  2365. CALL Close(prefs)
  2366. END
  2367. END
  2368. END
  2369. RETURN
  2370. loadtemp: 
  2371. IF tempsize=0 THEN RETURN
  2372. ok=Open(prefs,temp,"R")
  2373. IF ok THEN
  2374. DO
  2375. default=ReadCh(prefs,tempsize)
  2376. i=1
  2377. IF Length(default)=tempsize THEN
  2378. DO id=agads+1 TO agads+sgads
  2379. val.id=replacepat(SubStr(default,i,len.id),D2C(0),"")
  2380. i=i+len.id
  2381. END
  2382. CALL Close(prefs)
  2383. END
  2384. RETURN
  2385. savetemp: 
  2386. IF tempsize=0 THEN RETURN
  2387. ok=Open(prefs,temp,"W")
  2388. IF ok THEN
  2389. DO
  2390. default=""
  2391. DO id=agads+1 TO agads+sgads
  2392. default=default||Left(val.id,len.id,D2C(0))
  2393. END
  2394. CALL WriteCh(prefs,default)
  2395. CALL Close(prefs)
  2396. END
  2397. RETURN
  2398. updategadgets: 
  2399. IF ~cleangui THEN RETURN
  2400. DO id=1 TO agads
  2401. IF labs.id>=0 THEN CALL GT_SetGadgetAttrs(checkgad.id,win,Null(),GTCB_CHECKED,check.id)
  2402. IF labs.id~=0 THEN CALL GT_SetGadgetAttrs(cyclegad.id,win,Null(),GTCY_ACTIVE,cycle.id)
  2403. IF labs.id>0 THEN CALL GT_SetGadgetAttrs(intgad.id,win,Null(),GTIN_NUMBER,val.id)
  2404. END
  2405. DO id=agads+1 TO agads+sgads
  2406. IF gtype.id>0 THEN
  2407. CALL GT_SetGadgetAttrs(intgad.id,win,Null(),GTST_STRING,val.id)
  2408. ELSE
  2409. CALL GT_SetGadgetAttrs(intgad.id,win,Null(),GTIN_NUMBER,val.id)
  2410. END
  2411. CALL ClearMenuStrip(win)
  2412. item=GETVALUE(menu,18,4,"P")
  2413. DO n=menuoff+1 TO menuoff+mchks
  2414. flags=C2D(B2C(BitAnd(C2B(D2C(GETVALUE(item,12,2,"N"),2)),"1111111011111111")))+CHECKED*check.n
  2415. CALL SETVALUE(item,12,2,"N",flags,0)
  2416. item=GETVALUE(item,0,4,"P")
  2417. END
  2418. CALL ResetMenuStrip(win,menu)
  2419. RETURN
  2420. newdoc: 
  2421. IF portok THEN
  2422. DO
  2423. Status "FILENAME"
  2424. doc=RESULT
  2425. WinToFront
  2426. END
  2427. ELSE
  2428. doc="???"
  2429. IF doc="" THEN doc=unnamed
  2430. wintitle=replacepat(wtitle,"@f",doc)
  2431. scrtitle=replacepat(stitle,"@f",doc)
  2432. IF cleangui THEN
  2433. DO
  2434. CALL SetWindowTitles(win,wintitle,scrtitle)
  2435. IF ~windowpos THEN CALL WindowToFront(win)
  2436. CALL ActivateWindow(win)
  2437. END
  2438. RETURN
  2439. SYNTAX: 
  2440. et=ErrorText(RC)
  2441. ERROR:
  2442. err=RC
  2443. line=SIGL
  2444. IF errtrap=-1 THEN CALL bye(err)
  2445. IF errtrap=-2 THEN EXIT err
  2446. IF err=errtrap THEN
  2447. DO
  2448. errtrap=0
  2449. i=resume
  2450. DROP resume
  2451. trapped=1
  2452. SIGNAL VALUE i
  2453. END
  2454. RESUME:
  2455. errtrap=-1
  2456. IF et="" THEN et=fwerrtext.err
  2457. CALL message(err,replacepat(replacepat(replacepat(replacepat(errtext,"@n",err),"@l",line),"@t",et),"@s",SourceLine(line)))
  2458. CALL bye(err)
  2459. RETURN
  2460. BREAK_C: 
  2461. CALL bye(2)
  2462. RETURN
  2463.